Mailto override.
This commit is contained in:
parent
3c9a3fe856
commit
33d2bf9088
2 changed files with 15 additions and 5 deletions
|
@ -37,7 +37,8 @@
|
||||||
mailman
|
mailman
|
||||||
texts
|
texts
|
||||||
tests
|
tests
|
||||||
reminders)
|
reminders
|
||||||
|
util-mail)
|
||||||
|
|
||||||
;; Print banner
|
;; Print banner
|
||||||
(print "HackerBase 0.9.4 (c) 2023 Brmlab, z.s.")
|
(print "HackerBase 0.9.4 (c) 2023 Brmlab, z.s.")
|
||||||
|
@ -100,6 +101,8 @@
|
||||||
(-show-destroyed- #t))
|
(-show-destroyed- #t))
|
||||||
(-sendmail () "Actually send emails"
|
(-sendmail () "Actually send emails"
|
||||||
(-send-emails- #t))
|
(-send-emails- #t))
|
||||||
|
(-mailto (email) "Override all outgoing emails destination"
|
||||||
|
(*mailto-override* email))
|
||||||
""
|
""
|
||||||
"Query options:"
|
"Query options:"
|
||||||
(-mi (id) "Specify member by id" (-member-id- (string->number id)))
|
(-mi (id) "Specify member by id" (-member-id- (string->number id)))
|
||||||
|
|
|
@ -28,6 +28,7 @@
|
||||||
(module
|
(module
|
||||||
util-mail
|
util-mail
|
||||||
(
|
(
|
||||||
|
*mailto-override*
|
||||||
send-mail
|
send-mail
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -36,6 +37,9 @@
|
||||||
(chicken keyword)
|
(chicken keyword)
|
||||||
util-io)
|
util-io)
|
||||||
|
|
||||||
|
;; All emails go to this override
|
||||||
|
(define *mailto-override* (make-parameter "dominik.pantucek@trustica.cz"))
|
||||||
|
|
||||||
;; Sends an email using the UNIX mail(1) utility.
|
;; Sends an email using the UNIX mail(1) utility.
|
||||||
(define (send-mail body-lines . args)
|
(define (send-mail body-lines . args)
|
||||||
(let ((from (get-keyword #:from args))
|
(let ((from (get-keyword #:from args))
|
||||||
|
@ -45,16 +49,19 @@
|
||||||
(error 'send-mail "requires #:to argument"))
|
(error 'send-mail "requires #:to argument"))
|
||||||
(when (not subject)
|
(when (not subject)
|
||||||
(error 'send-mail "requires #:subject argument"))
|
(error 'send-mail "requires #:subject argument"))
|
||||||
(let ((tos (if (list? to)
|
(let* ((tos (if (list? to)
|
||||||
to
|
to
|
||||||
(list to))))
|
(list to)))
|
||||||
|
(real-tos (if (*mailto-override*)
|
||||||
|
(list (*mailto-override*))
|
||||||
|
tos)))
|
||||||
(apply process-send/recv
|
(apply process-send/recv
|
||||||
"mail"
|
"mail"
|
||||||
(append (if from
|
(append (if from
|
||||||
(list "-r" from)
|
(list "-r" from)
|
||||||
'())
|
'())
|
||||||
(list "-s" subject)
|
(list "-s" subject)
|
||||||
tos)
|
real-tos)
|
||||||
body-lines))))
|
body-lines))))
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue