brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Remove mailman2 support.

Browse source
This commit is contained in:
Dominik Pantůček 2025-01-30 21:42:28 +01:00
parent ac83dd9c72
commit 9f5877d3f0
3 changed files with 9 additions and 129 deletions
Download patch file Download diff file Expand all files Collapse all files

16
src/Makefile
View file

@ -60,7 +60,7 @@ HACKERBASE-OBJS=hackerbase.o testing.o listing.o cal-month.o \
table-style.o sgr-state.o util-utf8.o sgr-cell.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 \
util-bst-bdict.o util-bst-ldict.o util-bst-lset.o \
mailman-common.o mailman3.o mailman3-sql.o tiocgwinsz.o \
mailinglist.o export-sheet.o mbase-query.o qr-payment.o
@ -260,13 +260,6 @@ ENVIRONMENT-SOURCES=environment.scm ansi.import.scm
environment.o: environment.import.scm
environment.import.scm: $(ENVIRONMENT-SOURCES)
MAILMAN2-SOURCES=mailman2.scm util-bst-lset.import.scm \
util-io.import.scm mailman-common.import.scm \
configuration.import.scm
mailman2.o: mailman2.import.scm
mailman2.import.scm: $(MAILMAN2-SOURCES)
UTIL-TIME-SOURCES=util-time.scm duck.import.scm
util-time.o: util-time.import.scm
@ -527,10 +520,9 @@ UTIL-BST-LSET-SOURCES=util-bst-lset.scm util-bst.import.scm \
util-bst-lset.o: util-bst-lset.import.scm
util-bst-lset.import.scm: $(UTIL-BST-LSET-SOURCES)
MAILMAN-SOURCES=mailman.scm mailman2.import.scm \
mailman-common.import.scm util-bst-lset.import.scm \
configuration.import.scm mailman3.import.scm \
progress.import.scm
MAILMAN-SOURCES=mailman.scm mailman-common.import.scm \
util-bst-lset.import.scm configuration.import.scm \
mailman3.import.scm progress.import.scm
mailman.o: mailman.import.scm
mailman.import.scm: $(MAILMAN-SOURCES)

18
src/mailman.scm
View file

@ -49,7 +49,6 @@
(import scheme
(chicken base)
(chicken module)
mailman2
mailman-common
util-bst-lset
configuration
@ -59,24 +58,17 @@
;; Syntax for simplifying export of case-version procedures
(define-syntax define-mailman-proc
(syntax-rules ()
((_ name proc2)
((_ name proc3)
(begin
(export name)
(define (name . args)
(case (*mailman-version*)
((2) (apply proc2 args))))))
((_ name proc2 proc3)
(begin
(export name)
(define (name . args)
(case (*mailman-version*)
((2) (apply proc2 args))
((3) (apply proc3 args))))))))
(define-mailman-proc list-mailman-lists
list-mailman2-lists list-mailman3-lists)
list-mailman3-lists)
(define-mailman-proc list-mailman-list-members
list-mailman2-list-members list-mailman3-list-members)
list-mailman3-list-members)
;; Loads a single mailman list as mailman structure, if
;; unsuccessfull, returns only a list with ML name and no member
@ -112,9 +104,9 @@
(assoc name lsts))
(define-mailman-proc add-email-to-mailman-list
add-email-to-mailman2-list add-email-to-mailman3-list)
add-email-to-mailman3-list)
(define-mailman-proc remove-email-from-mailman-list
remove-email-from-mailman2-list remove-email-from-mailman3-list)
remove-email-from-mailman3-list)
;; Ensures given email is in given ML
(define (mailman-ensure-member ml email)

104
src/mailman2.scm
View file

@ -1,104 +0,0 @@
;;
;; mailman2.scm
;;
;; Mailman management interface - Mailman version 2.x support
;;
;; ISC License
;;
;; Copyright 2023 Brmlab, z.s.
;; Dominik Pantůček <dominik.pantucek@trustica.cz>
;;
;; 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 mailman2))
(module
mailman2
(
list-mailman2-lists
list-mailman2-list-members
add-email-to-mailman2-list
remove-email-from-mailman2-list
)
(import scheme
(chicken base)
(chicken pathname)
(chicken string)
(chicken sort)
(chicken format)
srfi-1
util-bst-lset
util-io
mailman-common
configuration)
;; Returns full path to given mailman binary
(define (mailman-bin bin)
(make-pathname (*mailman2-bin*) bin))
;; Mailman-specific process output lines capture
(define (get-mailman-output-lines bin . args)
(apply
get-process-output-lines
(mailman-bin bin)
args))
;; Sends all lines to the process
(define (mailman-send/recv bin args . lines)
(apply
process-send/recv
(mailman-bin bin)
args
lines))
;; Returns the list of available lists
(define (list-mailman2-lists)
(get-mailman-output-lines "list_lists" "-b"))
;; Returns the list of members of given list
(define (list-mailman2-list-members lst)
(sort
(get-mailman-output-lines "list_members" lst)
string-ci<?))
;; Adds given email to given listname
(define (add-email-to-mailman2-list listname email)
(print "Add " email " to " listname ".")
(let ((result
(mailman-send/recv
"add_members"
(list "-r" "-" listname)
email)))
(let loop ((lines result))
(when (not (null? lines))
(print " | " (car lines))
(loop (cdr lines))))))
;; Removes given email from given listname
(define (remove-email-from-mailman2-list listname email)
(print "Remove " email " from " listname ".")
(let ((result
(get-mailman-output-lines
"remove_members" listname
(sprintf "~A" email))))
(let loop ((lines result))
(when (not (null? lines))
(print " | " (car lines))
(loop (cdr lines))))))
)