From 765bfbf4d9e4cd22371313f653cd6431034798f0 Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Mon, 18 May 2020 12:54:52 +0200 Subject: 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. --- src/mcron/redirect.scm | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) (limited to 'src/mcron') 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 +;;; Copyright © 2020 Mathieu Lirzin ;;; Copyright © 2018 宋文武 ;;; ;;; 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) -- cgit v1.2.3