Work on new ML checkers.
This commit is contained in:
parent
fbe3f02128
commit
3f2283e1ca
1 changed files with 30 additions and 17 deletions
|
@ -226,7 +226,7 @@
|
||||||
#f))
|
#f))
|
||||||
|
|
||||||
;; Load ML(s) and merge them
|
;; Load ML(s) and merge them
|
||||||
(define-values (MB1 internal-ml MLS)
|
(define-values (MB1 MLS)
|
||||||
(if MB0
|
(if MB0
|
||||||
(let ()
|
(let ()
|
||||||
(define mls (load-mailman-lists))
|
(define mls (load-mailman-lists))
|
||||||
|
@ -234,9 +234,11 @@
|
||||||
(mbase-merge-mailman mb ml))
|
(mbase-merge-mailman mb ml))
|
||||||
MB0
|
MB0
|
||||||
mls)
|
mls)
|
||||||
(find-mailman-list mls "internal")
|
|
||||||
MLS))
|
MLS))
|
||||||
(values #f #f #f)))
|
(values #f #f)))
|
||||||
|
(define internal-ml (if MLS (find-mailman-list MLS "internal") #f))
|
||||||
|
(define council-ml (if MLS (find-mailman-list MLS "rada") #f))
|
||||||
|
(define revision-ml (if MLS (find-mailman-list MLS "rk") #f))
|
||||||
|
|
||||||
;; Load DokuWiki users
|
;; Load DokuWiki users
|
||||||
(define MB (if MB1
|
(define MB (if MB1
|
||||||
|
@ -281,6 +283,30 @@
|
||||||
(print " " (car keys) ": " (length (ldict-ref status (car keys)))))
|
(print " " (car keys) ": " (length (ldict-ref status (car keys)))))
|
||||||
(loop (cdr keys)))))))
|
(loop (cdr keys)))))))
|
||||||
|
|
||||||
|
(define (capitalize s)
|
||||||
|
(let ((l (string->list s)))
|
||||||
|
(list->string
|
||||||
|
(cons
|
||||||
|
(char-upcase (car l))
|
||||||
|
(cdr l)))))
|
||||||
|
|
||||||
|
(define (check-mailing-list mls name)
|
||||||
|
(define ml (find-mailman-list mls name))
|
||||||
|
(let-values (((missing surplus)
|
||||||
|
(mailman-compare-members ml
|
||||||
|
(mbase-active-emails MB #:suspended #t))))
|
||||||
|
(if (null? (cdr ml))
|
||||||
|
(print "Skipping ML check - not loaded")
|
||||||
|
(if (and (null? missing)
|
||||||
|
(null? surplus))
|
||||||
|
(print (format "~a mailing list membership in sync." (capitalize name)))
|
||||||
|
(let ()
|
||||||
|
(print (format "~a mailing list:" (capitalize name)))
|
||||||
|
(when (not (null? missing))
|
||||||
|
(print " Missing: " missing))
|
||||||
|
(when (not (null? surplus))
|
||||||
|
(print " Outsiders: " surplus)))))))
|
||||||
|
|
||||||
;; Perform requested action
|
;; Perform requested action
|
||||||
(case (-action-)
|
(case (-action-)
|
||||||
((print-info)
|
((print-info)
|
||||||
|
@ -292,20 +318,7 @@
|
||||||
(let ()
|
(let ()
|
||||||
(print-members-base-table MB)
|
(print-members-base-table MB)
|
||||||
(newline)
|
(newline)
|
||||||
(let-values (((missing surplus)
|
(check-mailing-list MLS "internal")
|
||||||
(mailman-compare-members internal-ml
|
|
||||||
(mbase-active-emails MB #:suspended #t))))
|
|
||||||
(if (null? (cdr internal-ml))
|
|
||||||
(print "Skipping ML check - not loaded")
|
|
||||||
(if (and (null? missing)
|
|
||||||
(null? surplus))
|
|
||||||
(print "Internal mailing list membership in sync.")
|
|
||||||
(let ()
|
|
||||||
(print "Internal mailing list:")
|
|
||||||
(when (not (null? missing))
|
|
||||||
(print " Missing: " missing))
|
|
||||||
(when (not (null? surplus))
|
|
||||||
(print " Outsiders: " surplus))))))
|
|
||||||
(print-git-status)))
|
(print-git-status)))
|
||||||
(newline))
|
(newline))
|
||||||
((print-stats)
|
((print-stats)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue