Work on new ML checkers.

This commit is contained in:
Dominik Pantůček 2023-11-16 18:31:39 +01:00
parent fbe3f02128
commit 3f2283e1ca

View file

@ -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)