diff --git a/src/Makefile b/src/Makefile index 9ce79b5..bf542ff 100644 --- a/src/Makefile +++ b/src/Makefile @@ -42,7 +42,7 @@ HACKERBASE-DEPS=hackerbase.scm cal-month.import.scm \ tests.import.scm notifications.import.scm logging.import.scm \ progress.import.scm cal-period.import.scm \ util-stdout.import.scm export-web-static.import.scm \ - dokuwiki.import.scm + dokuwiki.import.scm mailinglist.import.scm HACKERBASE-OBJS=hackerbase.o testing.o listing.o cal-month.o \ cal-period.o ansi.o util-bst-ldict.o command-line.o mbase.o \ @@ -59,7 +59,8 @@ HACKERBASE-OBJS=hackerbase.o testing.o listing.o cal-month.o \ template-list-expander.o box-drawing.o export-web-static.o \ util-dir.o dokuwiki.o racket-kwargs.o duck.o util-bst.o \ util-bst-bdict.o util-bst-ldict.o util-bst-lset.o mailman2.o \ - mailman-common.o mailman3.o mailman3-sql.o tiocgwinsz.o + mailman-common.o mailman3.o mailman3-sql.o tiocgwinsz.o \ + mailinglist.o GENDOC-SOURCES=gendoc.scm duck-extract.import.scm \ util-time.import.scm util-csv.import.scm util-git.import.scm \ @@ -550,3 +551,9 @@ TIOCGWINSZ-SOURCES=tiocgwinsz.scm duck.import.scm tiocgwinsz.o: tiocgwinsz.import.scm tiocgwinsz.import.scm: $(TIOCGWINSZ-SOURCES) + +MAILINGLIST-SOURCES=mailinglist.scm racket-kwargs.import.scm \ + mailman.import.scm mbase.import.scm util-string.import.scm + +mailinglist.o: mailinglist.import.scm +mailinglist.import.scm: $(MAILINGLIST-SOURCES) diff --git a/src/hackerbase.scm b/src/hackerbase.scm index 0cd8438..08b9b80 100644 --- a/src/hackerbase.scm +++ b/src/hackerbase.scm @@ -50,7 +50,8 @@ export-web-static dokuwiki racket-kwargs - util-string) + util-string + mailinglist) ;; Command-line options and configurable parameters (define -needs-bank- (make-parameter #f)) @@ -286,27 +287,6 @@ (print " " (car keys) ": " (length (ldict-ref status (car keys))))) (loop (cdr keys))))))) -(define* (check-mailing-list mls name #:pred? (pred? #f) #:suspended (suspended #f)) - (define ml (find-mailman-list mls name)) - (when ml - (let-values (((missing surplus) - (mailman-compare-members ml - (mbase-active-emails MB - #:suspended suspended - #:pred? pred? - )))) - (if (null? (cdr ml)) - (print "Skipping ML check - not loaded") - (if (and (null? missing) - (null? surplus)) - (print (format "~a mailing list membership in sync." (string-capitalize name))) - (let () - (print (format "~a mailing list:" (string-capitalize name))) - (when (not (null? missing)) - (print " Missing: " missing)) - (when (not (null? surplus)) - (print " Outsiders: " surplus)))))))) - (define (rada-ml-pred? mr) (or (brmember-council? mr) (brmember-chair? mr) @@ -323,10 +303,10 @@ (let () (print-members-base-table MB) (newline) - (check-mailing-list MLS "internal" #:suspended #t) - (check-mailing-list MLS "rada" + (check-mailing-list MB MLS "internal" #:suspended #t) + (check-mailing-list MB MLS "rada" #:pred? rada-ml-pred?) - (check-mailing-list MLS "rk" #:pred? brmember-revision?) + (check-mailing-list MB MLS "rk" #:pred? brmember-revision?) (print-git-status))) (newline)) ((print-stats) diff --git a/src/mailinglist.scm b/src/mailinglist.scm new file mode 100644 index 0000000..9f227f4 --- /dev/null +++ b/src/mailinglist.scm @@ -0,0 +1,63 @@ +;; +;; mailinglist.scm +;; +;; Common high-level mailinglist management procedures. +;; +;; ISC License +;; +;; Copyright 2023 Brmlab, z.s. +;; Dominik Pantůček +;; +;; Permission to use, copy, modify, and/or distribute this software +;; for any purpose with or without fee is hereby granted, provided +;; that the above copyright notice and this permission notice appear +;; in all copies. +;; +;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL +;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED +;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE +;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR +;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS +;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, +;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN +;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. +;; + +(declare (unit mailinglist)) + +(module + mailinglist + ( + check-mailing-list + ) + + (import scheme + (chicken base) + (chicken format) + racket-kwargs + mailman + mbase + util-string) + + (define* (check-mailing-list MB mls name #:pred? (pred? #f) #:suspended (suspended #f)) + (define ml (find-mailman-list mls name)) + (when ml + (let-values (((missing surplus) + (mailman-compare-members ml + (mbase-active-emails MB + #:suspended suspended + #:pred? pred? + )))) + (if (null? (cdr ml)) + (print "Skipping ML check - not loaded") + (if (and (null? missing) + (null? surplus)) + (print (format "~a mailing list membership in sync." (string-capitalize name))) + (let () + (print (format "~a mailing list:" (string-capitalize name))) + (when (not (null? missing)) + (print " Missing: " missing)) + (when (not (null? surplus)) + (print " Outsiders: " surplus)))))))) + + )