Add support for email headers.

src/notifications.scm

@@ -60,6 +60,8 @@
    (print "### From: " (ldict-ref em 'from (*email-from*)))
    (print "### To: " (ldict-ref em 'to))
    (print "### Subject: " (ldict-ref em 'subject))
+   (when (*notifications-cc*)
+     (print "### CC: " (*notifications-cc*)))
    (let loop ((lines (ldict-ref em 'body)))
      (when (not (null? lines))
        (print (car lines))
@@ -75,6 +77,7 @@
 		 ""))
    (send-mail (ldict-ref em 'body)
 	      #:from (*email-from*)
+	      #:headers (ldict-ref em 'headers '())
 	      #:to (ldict-ref em 'to)
 	      #:subject (ldict-ref em 'subject)))
 

src/util-mail.scm

@@ -65,11 +65,13 @@ sent to the address stored within.")
  (define*/doc (send-mail body-lines
 			 #:from (from #f)
 			 #:to to
-			 #:subject subject)
+			 #:subject subject
+			 #:headers (headers '()))
    ("* ```body-lines``` - lines of the email
 * ```from``` - email address from string
 * ```to``` - email address to string
 * ```subject``` - email subject string
+* ```headers``` - list of headers to add
 
 Sends email using mail(1) command. The arguments ```#:to``` and
 ```#:subject``` are mandatory. Argument ```#:from``` is optional.")
@@ -78,14 +80,20 @@ Sends email using mail(1) command. The arguments ```#:to``` and
 		   (list to)))
 	  (real-tos (if (*mailto-override*)
 			(list (*mailto-override*))
-			tos)))
+			tos))
+	  (header-args
+	   (flatten
+	    (map
+	     (lambda (h) (list "-a" h))
+	     headers))))
      (apply process-send/recv
 	    "mail"
 	    (append (if from
 			(list "-r" from)
 			'())
 		    (list "-s" (encode-subject subject))
-		    real-tos)
+		    real-tos
+		    header-args)
 	    body-lines)))
 
  )