diff options
| author | Mathieu Lirzin <mthl@gnu.org> | 2020-05-18 12:54:52 +0200 |
|---|---|---|
| committer | Dale Mellor <mcron-lsfnyl@rdmp.org> | 2020-06-08 08:49:51 +0100 |
| commit | 765bfbf4d9e4cd22371313f653cd6431034798f0 (patch) | |
| tree | 788255c7b8bcea321460cca6bd0706028cddb546 /src/mcron | |
| parent | 92a940cca55a07efb67c7588bbca99a9fe305025 (diff) | |
| download | mcron-765bfbf4d9e4cd22371313f653cd6431034798f0.tar.gz mcron-765bfbf4d9e4cd22371313f653cd6431034798f0.tar.bz2 mcron-765bfbf4d9e4cd22371313f653cd6431034798f0.zip | |
tests: Check (mcron redirect)
* tests/redirect.scm: New file.
* Makefile.am (TESTS): Register it.
* src/mcron/redirect.scm (with-mail-out): Adapt to facilitate testing.
Diffstat (limited to 'src/mcron')
| -rw-r--r-- | src/mcron/redirect.scm | 12 |
1 files changed, 8 insertions, 4 deletions
diff --git a/src/mcron/redirect.scm b/src/mcron/redirect.scm index b7df42c..8374552 100644 --- a/src/mcron/redirect.scm +++ b/src/mcron/redirect.scm @@ -1,5 +1,6 @@ ;;;; redirect.scm -- modify job outputs ;;; Copyright © 2003 Dale Mellor <dale_mellor@users.sourceforge.net> +;;; Copyright © 2020 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2018 宋文武 <iyzsong@member.fsf.org> ;;; ;;; This file is part of GNU Mcron. @@ -63,7 +64,10 @@ ;; the string, and output (including the error output) being sent to a pipe ;; opened on a mail transport. -(define (with-mail-out action . user) +(define* (with-mail-out action #:optional user #:key + (hostname (gethostname)) + (out (lambda () + (open-output-pipe config-sendmail)))) ;; Determine the name of the user who is to recieve the mail, looking for a ;; name in the optional user argument, then in the MAILTO environment @@ -72,7 +76,7 @@ (let* ((mailto (getenv "MAILTO")) (user (cond (mailto mailto) - ((not (null? user)) (car user)) + (user user) (else (getenv "LOGNAME")))) (parent->child (pipe)) (child->parent (pipe)) @@ -173,11 +177,11 @@ (open-output-file "/dev/null") ;; The sendmail command should read ;; recipients from the message header. - (open-output-pipe config-sendmail))) + (out))) (set-current-input-port (car child->parent)) (display "To: ") (display user) (newline) (display "From: mcron") (newline) - (display (string-append "Subject: " user "@" (gethostname))) + (display (string-append "Subject: " user "@" hostname)) (newline) (newline) |