Compare commits
5 commits
5f4724874e
...
c648fe8c52
Author | SHA1 | Date | |
---|---|---|---|
c648fe8c52 | |||
42620b38ff | |||
b0b558c8d4 | |||
c06bc95b36 | |||
37b608ab67 |
14 changed files with 73 additions and 63 deletions
|
@ -1,6 +1,14 @@
|
||||||
ChangeLog
|
ChangeLog
|
||||||
=========
|
=========
|
||||||
|
|
||||||
|
1.19 - released 2025-04-16
|
||||||
|
--------------------------
|
||||||
|
|
||||||
|
* manpage updated
|
||||||
|
* added -n option for dry-runs
|
||||||
|
* removed mailman 2.x support
|
||||||
|
* added "councilml" start/stop support for member files
|
||||||
|
|
||||||
1.18 - released 2025-01-06
|
1.18 - released 2025-01-06
|
||||||
--------------------------
|
--------------------------
|
||||||
|
|
||||||
|
|
|
@ -1,22 +0,0 @@
|
||||||
set terminal pngcairo size 1000,600
|
|
||||||
set title "Members stats"
|
|
||||||
set output 'members-base-stats-2023-11.png'
|
|
||||||
|
|
||||||
src='members-base-stats-2023-11.data'
|
|
||||||
|
|
||||||
set timefmt "%Y-%m"
|
|
||||||
set xdata time
|
|
||||||
set format x "%Y-%m"
|
|
||||||
|
|
||||||
set xlabel "Month"
|
|
||||||
set ylabel "Members"
|
|
||||||
|
|
||||||
set grid
|
|
||||||
|
|
||||||
set key out right
|
|
||||||
|
|
||||||
plot[1420066800:][0:] \
|
|
||||||
src u 1:3 w l lw 2 t 'active', \
|
|
||||||
src u 1:4 w l t 'suspended', \
|
|
||||||
src u 1:5 w l t 'students', \
|
|
||||||
src u 1:6 w l t 'destroyed'
|
|
|
@ -187,8 +187,8 @@ PROGRESS-SOURCES=progress.scm util-time.import.scm
|
||||||
progress.o: progress.import.scm
|
progress.o: progress.import.scm
|
||||||
progress.import.scm: $(PROGRESS-SOURCES)
|
progress.import.scm: $(PROGRESS-SOURCES)
|
||||||
|
|
||||||
EXPORT-CARDS-SOURCES=export-cards.scm util-bst-ldict.import.scm \
|
EXPORT-CARDS-SOURCES=export-cards.scm util-bst-ldict.import.scm \
|
||||||
mbase.import.scm brmember.import.scm
|
mbase.import.scm brmember.import.scm configuration.import.scm
|
||||||
|
|
||||||
export-cards.o: export-cards.import.scm
|
export-cards.o: export-cards.import.scm
|
||||||
export-cards.import.scm: $(EXPORT-CARDS-SOURCES)
|
export-cards.import.scm: $(EXPORT-CARDS-SOURCES)
|
||||||
|
|
|
@ -61,7 +61,8 @@
|
||||||
grantstart grantstop
|
grantstart grantstop
|
||||||
joined destroyed
|
joined destroyed
|
||||||
feestart feestop
|
feestart feestop
|
||||||
phone))
|
phone
|
||||||
|
councilmlstart councilmlstop))
|
||||||
(define ignored-keys '(mail2))
|
(define ignored-keys '(mail2))
|
||||||
|
|
||||||
(define known-keys (append mandatory-keys optional-keys))
|
(define known-keys (append mandatory-keys optional-keys))
|
||||||
|
@ -88,6 +89,9 @@
|
||||||
|
|
||||||
(feestart fee start)
|
(feestart fee start)
|
||||||
(feestop fee stop)
|
(feestop fee stop)
|
||||||
|
|
||||||
|
(councilmlstart councilml start)
|
||||||
|
(councilmlstop councilml stop)
|
||||||
))
|
))
|
||||||
(define start-stop-markers (map car start-stop-markers-lookup))
|
(define start-stop-markers (map car start-stop-markers-lookup))
|
||||||
|
|
||||||
|
@ -114,7 +118,7 @@
|
||||||
(info
|
(info
|
||||||
,(lambda (mr output key value)
|
,(lambda (mr output key value)
|
||||||
(case key
|
(case key
|
||||||
((student suspend member revision chair council grant fee)
|
((student suspend member revision chair council grant fee councilml)
|
||||||
(let* ((res (period-markers->cal-periods value))
|
(let* ((res (period-markers->cal-periods value))
|
||||||
(ok? (car res))
|
(ok? (car res))
|
||||||
(periods0 (cadr res))
|
(periods0 (cadr res))
|
||||||
|
|
|
@ -65,6 +65,7 @@
|
||||||
|
|
||||||
brmember-chair?
|
brmember-chair?
|
||||||
brmember-council?
|
brmember-council?
|
||||||
|
brmember-councilml?
|
||||||
brmember-revision?
|
brmember-revision?
|
||||||
brmember-grant?
|
brmember-grant?
|
||||||
|
|
||||||
|
@ -394,6 +395,7 @@
|
||||||
;; Predicates for all organizational bodies recognized
|
;; Predicates for all organizational bodies recognized
|
||||||
(define brmember-chair? (brmember-body? 'chair))
|
(define brmember-chair? (brmember-body? 'chair))
|
||||||
(define brmember-council? (brmember-body? 'council))
|
(define brmember-council? (brmember-body? 'council))
|
||||||
|
(define brmember-councilml? (brmember-body? 'councilml))
|
||||||
(define brmember-revision? (brmember-body? 'revision))
|
(define brmember-revision? (brmember-body? 'revision))
|
||||||
(define brmember-grant? (brmember-body? 'grant))
|
(define brmember-grant? (brmember-body? 'grant))
|
||||||
|
|
||||||
|
|
|
@ -43,6 +43,7 @@
|
||||||
*mailman3-sql*
|
*mailman3-sql*
|
||||||
*mailman3-sql-path*
|
*mailman3-sql-path*
|
||||||
*notifications-cc*
|
*notifications-cc*
|
||||||
|
*dummy-run*
|
||||||
|
|
||||||
load-configuration!
|
load-configuration!
|
||||||
)
|
)
|
||||||
|
@ -100,7 +101,7 @@
|
||||||
|
|
||||||
;; Which version of mailman to use
|
;; Which version of mailman to use
|
||||||
(define *mailman-version* (make-parameter #f))
|
(define *mailman-version* (make-parameter #f))
|
||||||
(define =mailman-version= 2)
|
(define =mailman-version= 3)
|
||||||
|
|
||||||
;; What is the mailman 3 command
|
;; What is the mailman 3 command
|
||||||
(define *mailman3-bin* (make-parameter #f))
|
(define *mailman3-bin* (make-parameter #f))
|
||||||
|
@ -111,7 +112,7 @@
|
||||||
;; A string is the default, gets converted to boolean at the end of
|
;; A string is the default, gets converted to boolean at the end of
|
||||||
;; loading configuration
|
;; loading configuration
|
||||||
(define *mailman3-sql* (make-parameter #f))
|
(define *mailman3-sql* (make-parameter #f))
|
||||||
(define =mailman3-sql= "0")
|
(define =mailman3-sql= "1")
|
||||||
|
|
||||||
;; The path to SQLite3 DB file
|
;; The path to SQLite3 DB file
|
||||||
(define *mailman3-sql-path* (make-parameter #f))
|
(define *mailman3-sql-path* (make-parameter #f))
|
||||||
|
@ -121,6 +122,9 @@
|
||||||
(define *notifications-cc* (make-parameter #f))
|
(define *notifications-cc* (make-parameter #f))
|
||||||
(define =notifications-cc= "rada@brmlab.cz")
|
(define =notifications-cc= "rada@brmlab.cz")
|
||||||
|
|
||||||
|
;; If #t, do not do anything
|
||||||
|
(define *dummy-run* (make-parameter #f))
|
||||||
|
|
||||||
(define (load-single-configuration! fname)
|
(define (load-single-configuration! fname)
|
||||||
(when (file-exists? fname)
|
(when (file-exists? fname)
|
||||||
(let loop ((lines (read-lines (open-input-file fname))))
|
(let loop ((lines (read-lines (open-input-file fname))))
|
||||||
|
|
|
@ -38,7 +38,8 @@
|
||||||
(chicken irregex)
|
(chicken irregex)
|
||||||
util-bst-ldict
|
util-bst-ldict
|
||||||
mbase
|
mbase
|
||||||
brmember)
|
brmember
|
||||||
|
configuration)
|
||||||
|
|
||||||
;; Prints single card type records.
|
;; Prints single card type records.
|
||||||
(define (cards-print/type mb type)
|
(define (cards-print/type mb type)
|
||||||
|
@ -84,7 +85,8 @@
|
||||||
|
|
||||||
;; Exports cards and desfires to the files specified.
|
;; Exports cards and desfires to the files specified.
|
||||||
(define (cards-export mb cardsfn desfirefn)
|
(define (cards-export mb cardsfn desfirefn)
|
||||||
(cards-export/type mb 'card cardsfn)
|
(when (not (*dummy-run*))
|
||||||
(cards-export/type mb 'desfire desfirefn))
|
(cards-export/type mb 'card cardsfn)
|
||||||
|
(cards-export/type mb 'desfire desfirefn)))
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
|
@ -191,10 +191,11 @@
|
||||||
|
|
||||||
;; Generates all members in given directory
|
;; Generates all members in given directory
|
||||||
(define (gen-html-members mb dir)
|
(define (gen-html-members mb dir)
|
||||||
(ensure-directory dir)
|
(when (not (*dummy-run*))
|
||||||
(with-mbase-progress%
|
(ensure-directory dir)
|
||||||
mb dir mr
|
(with-mbase-progress%
|
||||||
(gen-html-member mr dir))
|
mb dir mr
|
||||||
(clean-members-files mb dir))
|
(gen-html-member mr dir))
|
||||||
|
(clean-members-files mb dir)))
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
|
@ -116,6 +116,8 @@
|
||||||
(-mailman3-sql-path (path) "Set mailman3 direct SQL access path"
|
(-mailman3-sql-path (path) "Set mailman3 direct SQL access path"
|
||||||
(*mailman3-sql* "1")
|
(*mailman3-sql* "1")
|
||||||
(*mailman3-sql-path* path))
|
(*mailman3-sql-path* path))
|
||||||
|
(-n () "Do not do anything"
|
||||||
|
(*dummy-run* #t))
|
||||||
""
|
""
|
||||||
"Email options:"
|
"Email options:"
|
||||||
(-from (email) "Sender email address"
|
(-from (email) "Sender email address"
|
||||||
|
|
|
@ -73,6 +73,7 @@
|
||||||
(define (rada-ml-pred? mr)
|
(define (rada-ml-pred? mr)
|
||||||
(or (brmember-council? mr)
|
(or (brmember-council? mr)
|
||||||
(brmember-chair? mr)
|
(brmember-chair? mr)
|
||||||
(brmember-revision? mr)))
|
(brmember-revision? mr)
|
||||||
|
(brmember-councilml? mr)))
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
|
@ -37,7 +37,8 @@
|
||||||
(chicken base)
|
(chicken base)
|
||||||
(chicken format)
|
(chicken format)
|
||||||
sqlite3
|
sqlite3
|
||||||
configuration)
|
configuration
|
||||||
|
(chicken condition))
|
||||||
|
|
||||||
;; Thread-local parameter to re-use SQLite3 DB handle for subsequent queries
|
;; Thread-local parameter to re-use SQLite3 DB handle for subsequent queries
|
||||||
(define *cached-mailman3-db* (make-parameter #f))
|
(define *cached-mailman3-db* (make-parameter #f))
|
||||||
|
@ -55,10 +56,15 @@
|
||||||
;; Returns the list of mailman3 mailinglists by querying te
|
;; Returns the list of mailman3 mailinglists by querying te
|
||||||
;; underlying SQLite3 DB directly
|
;; underlying SQLite3 DB directly
|
||||||
(define (list-mailman3-sql-lists)
|
(define (list-mailman3-sql-lists)
|
||||||
(let-values (((stmt _)
|
(handle-exceptions
|
||||||
(prepare (mailman3-db)
|
ex
|
||||||
"SELECT list_name FROM mailinglist")))
|
'()
|
||||||
(map-row identity stmt)))
|
(let ((result
|
||||||
|
(let-values (((stmt _)
|
||||||
|
(prepare (mailman3-db)
|
||||||
|
"SELECT list_name FROM mailinglist")))
|
||||||
|
(map-row identity stmt))))
|
||||||
|
result)))
|
||||||
|
|
||||||
;; Returns a list of email addresses subscribed to given mailinglist
|
;; Returns a list of email addresses subscribed to given mailinglist
|
||||||
(define (list-mailman3-sql-list-members lst)
|
(define (list-mailman3-sql-list-members lst)
|
||||||
|
|
|
@ -94,27 +94,29 @@
|
||||||
|
|
||||||
;; Adds given email
|
;; Adds given email
|
||||||
(define (add-email-to-mailman3-list lst email)
|
(define (add-email-to-mailman3-list lst email)
|
||||||
(print "Add " email " to " lst ".")
|
(print "Add " email " to " lst "." (if (*dummy-run*) " [no-op]" ""))
|
||||||
(let ((result
|
(when (not (*dummy-run*))
|
||||||
(mailman3-send/recv
|
(let ((result
|
||||||
(list "addmembers" "-" (format "~A@brmlab.cz" lst))
|
(mailman3-send/recv
|
||||||
email)))
|
(list "addmembers" "-" (format "~A@brmlab.cz" lst))
|
||||||
(let loop ((lines result))
|
email)))
|
||||||
(when (not (null? lines))
|
(let loop ((lines result))
|
||||||
(print " | " (car lines))
|
(when (not (null? lines))
|
||||||
(loop (cdr lines))))))
|
(print " | " (car lines))
|
||||||
|
(loop (cdr lines)))))))
|
||||||
|
|
||||||
;; Removes given email from given listname
|
;; Removes given email from given listname
|
||||||
(define (remove-email-from-mailman3-list lst email)
|
(define (remove-email-from-mailman3-list lst email)
|
||||||
(print "Remove " email " from " lst ".")
|
(print "Remove " email " from " lst "." (if (*dummy-run*) " [no-op]" ""))
|
||||||
(let ((result
|
(when (not (*dummy-run*))
|
||||||
(get-mailman3-output-lines
|
(let ((result
|
||||||
"delmembers"
|
(get-mailman3-output-lines
|
||||||
"-l" (format "~A@brmlab.cz" lst)
|
"delmembers"
|
||||||
"-m" email)))
|
"-l" (format "~A@brmlab.cz" lst)
|
||||||
(let loop ((lines result))
|
"-m" email)))
|
||||||
(when (not (null? lines))
|
(let loop ((lines result))
|
||||||
(print " | " (car lines))
|
(when (not (null? lines))
|
||||||
(loop (cdr lines))))))
|
(print " | " (car lines))
|
||||||
|
(loop (cdr lines)))))))
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
|
@ -114,7 +114,7 @@
|
||||||
(caddr c)))
|
(caddr c)))
|
||||||
(brmember-credit mr))
|
(brmember-credit mr))
|
||||||
#:border '(((#:right light) ... none) ...))))
|
#:border '(((#:right light) ... none) ...))))
|
||||||
((suspend student member council chair revision grant)
|
((suspend student member council chair revision grant councilml)
|
||||||
(let* ((pdata (cons (list "Since" "Until")
|
(let* ((pdata (cons (list "Since" "Until")
|
||||||
(map
|
(map
|
||||||
(lambda (p)
|
(lambda (p)
|
||||||
|
|
|
@ -39,7 +39,7 @@
|
||||||
(chicken format))
|
(chicken format))
|
||||||
|
|
||||||
;; Short banner
|
;; Short banner
|
||||||
(define banner-line "HackerBase 1.19-dev (c) 2023-2025 Brmlab, z.s.")
|
(define banner-line "HackerBase 1.19 (c) 2023-2025 Brmlab, z.s.")
|
||||||
|
|
||||||
;; Banner source with numbers for ANSI CSI SGR
|
;; Banner source with numbers for ANSI CSI SGR
|
||||||
(define banner-source "
|
(define banner-source "
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue