From 33d2bf90881e28f541de067223747de2a2189fcc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?=
 <dominik.pantucek@trustica.cz>
Date: Tue, 11 Apr 2023 09:39:07 +0200
Subject: [PATCH] Mailto override.

---
 src/hackerbase.scm |  5 ++++-
 src/util-mail.scm  | 15 +++++++++++----
 2 files changed, 15 insertions(+), 5 deletions(-)

diff --git a/src/hackerbase.scm b/src/hackerbase.scm
index 348c277..ba6f750 100644
--- a/src/hackerbase.scm
+++ b/src/hackerbase.scm
@@ -37,7 +37,8 @@
 	mailman
 	texts
 	tests
-	reminders)
+	reminders
+	util-mail)
 
 ;; Print banner
 (print "HackerBase 0.9.4 (c) 2023 Brmlab, z.s.")
@@ -100,6 +101,8 @@
 	     (-show-destroyed- #t))
  (-sendmail () "Actually send emails"
 	    (-send-emails- #t))
+ (-mailto (email) "Override all outgoing emails destination"
+	  (*mailto-override* email))
  ""
  "Query options:"
  (-mi (id) "Specify member by id" (-member-id- (string->number id)))
diff --git a/src/util-mail.scm b/src/util-mail.scm
index deeb242..f72edb2 100644
--- a/src/util-mail.scm
+++ b/src/util-mail.scm
@@ -28,6 +28,7 @@
 (module
  util-mail
  (
+  *mailto-override*
   send-mail
   )
 
@@ -36,6 +37,9 @@
 	 (chicken keyword)
 	 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.
  (define (send-mail body-lines . args)
    (let ((from (get-keyword #:from args))
@@ -45,16 +49,19 @@
        (error 'send-mail "requires #:to argument"))
      (when (not subject)
        (error 'send-mail "requires #:subject argument"))
-     (let ((tos (if (list? to)
-		    to
-		    (list to))))
+     (let* ((tos (if (list? to)
+		     to
+		     (list to)))
+	    (real-tos (if (*mailto-override*)
+			  (list (*mailto-override*))
+			  tos)))
        (apply process-send/recv
 	      "mail"
 	      (append (if from
 			  (list "-r" from)
 			  '())
 		      (list "-s" subject)
-		      tos)
+		      real-tos)
 	      body-lines))))
 
  )