dmbcs/mcron
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

tests: Check (mcron redirect)

Browse source 
* tests/redirect.scm: New file.
* Makefile.am (TESTS): Register it.
* src/mcron/redirect.scm (with-mail-out): Adapt to facilitate testing.
This commit is contained in:
Mathieu Lirzin 2020-05-18 12:54:52 +02:00 • committed by Dale Mellor
commit 765bfbf4d9
3 changed files with 62 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

1
Makefile.am
View file

@ -137,6 +137,7 @@ TESTS = \
tests/base.scm \
tests/environment.scm \
tests/job-specifier.scm \
tests/redirect.scm \
tests/utils.scm \
tests/vixie-specification.scm \
tests/vixie-time.scm

12
src/mcron/redirect.scm
View file

@ -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)

53
tests/redirect.scm Normal file
View file

@ -0,0 +1,53 @@
;;;; redirect.scm -- tests for (mcron redirect) module
;;; Copyright © 2020 Mathieu Lirzin <mthl@gnu.org>
;;;
;;; This file is part of GNU Mcron.
;;;
;;; GNU Mcron is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; GNU Mcron is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Mcron. If not, see <http://www.gnu.org/licenses/>.
(use-modules (ice-9 textual-ports)
(srfi srfi-1)
(srfi srfi-64)
(mcron redirect))
(setenv "TZ" "UTC0")
(test-begin "redirect")
(define out (mkstemp! (string-copy "foo-XXXXXX")))
(dynamic-wind
(const #t)
(lambda ()
(with-mail-out "echo 'foo'" "user0"
#:out (lambda () out)
#:hostname "localhost")
(flush-all-ports)
(test-equal "mail output"
"To: user0
From: mcron
Subject: user0@localhost
foo
"
(call-with-input-file (port-filename out) get-string-all)))
(lambda ()
(let ((fname (port-filename out)))
(close out)
(delete-file fname))))
(test-end)