Version to 1.2.0+dmbcs.

* tests/redirect.scm: New file.
* Makefile.am (TESTS): Register it.
* src/mcron/redirect.scm (with-mail-out): Adapt to facilitate testing.

Makefile.am

@@ -137,7 +137,9 @@ 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
 
 ## -------------- ##

configure.ac

@@ -20,7 +20,7 @@
 # along with GNU Mcron.  If not, see <http://www.gnu.org/licenses/>.
 
 AC_PREREQ(2.61)
-AC_INIT([GNU Mcron], [1.2.0], [bug-mcron@gnu.org])
+AC_INIT([GNU Mcron], [1.2.0+dmbcs], [bug-mcron@gnu.org])
 AC_CONFIG_SRCDIR([src/mcron/scripts/mcron.scm])
 AC_CONFIG_AUX_DIR([build-aux])
 AC_REQUIRE_AUX_FILE([test-driver.scm])

src/cron.in

@@ -2,9 +2,52 @@
 -*- scheme -*-
 !#
 
+;;;; cron -- run jobs at scheduled times
+;;; Copyright © 2003, 2012, 2020  Dale Mellor <mcron-lsfnyl@rdmp.org>
+;;; Copyright © 2015, 2016, 2018  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/>.
+
+
 (unless (getenv "MCRON_UNINSTALLED")
   (set! %load-path (cons "%modsrcdir%" %load-path))
   (set! %load-compiled-path (cons "%modbuilddir%" %load-compiled-path)))
 
-(use-modules (mcron scripts cron))
+(use-modules  (mcron scripts cron)
-(main)
+              (ice-9 command-line-processor))
+
+(process-command-line  (command-line)
+   application "cron"
+   version     "%VERSION%"
+   usage       "[OPTIONS]"
+   help-preamble
+ "Unless an option is specified, run a cron daemon as a detached process,"
+ "reading all the information in the usersʼ crontabs and in /etc/crontab."
+   option (--schedule=8 -s string->number
+                        "display the next N (or 8) jobs that will be"
+                        "run, and exit")
+   option (--noetc -n "do not check /etc/crontab for updates (use"
+                   "of this option is HIGHLY RECOMMENDED)")
+   help-postamble
+ "Mandatory or optional arguments to long options are also mandatory or "
+ "optional for any corresponding short options."
+   bug-address "%PACKAGE_BUGREPORT%"
+   copyright
+        "2003, 2012, 2015, 2016, 2018, 2020  Free Software Foundation, Inc."
+   license     GPLv3)
+
+
+(main --schedule --noetc)

src/crontab.in

@@ -2,8 +2,44 @@
 -*- scheme -*-
 !#
 
+;;;; crontab -- run jobs at scheduled times
+;;; Copyright © 2003, 2020  Dale Mellor <mcron-lsfnyl@rdmp.org>
+;;; Copyright © 2015, 2016, 2018  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/>.
+
+
 (unless (getenv "MCRON_UNINSTALLED")
   (set! %load-path (cons "%modsrcdir%" %load-path))
   (set! %load-compiled-path (cons "%modbuilddir%" %load-compiled-path)))
 
-((@ (mcron scripts crontab) main))
+(use-modules (mcron scripts crontab)
+             (ice-9 command-line-processor))
+
+(process-command-line  (command-line)
+   application "crontab"
+   version     "%VERSION%"
+   usage       "[-u user] { -e | -l | -r }"
+   help-preamble "the default operation is to replace, per 1003.2"
+   option (--user=  -u  "the user whose files are to be manipulated")
+   option (--edit   -e  "edit this userʼs crontab")
+   option (--list   -l  "list this userʼs crontab")
+   option (--remove -r  "delete the userʼs crontab")
+   bug-address "%PACKAGE_BUGREPORT%"
+   copyright   "2003, 2016, 2020  Free Software Foundation, Inc."
+   license     GPLv3)
+
+((@ (mcron scripts crontab) main) --user --edit --list --remove --!)

src/mcron.in

@@ -2,9 +2,55 @@
 -*- scheme -*-
 !#
 
+;;;; mcron -- run jobs at scheduled times
+;;; Copyright © 2003, 2012, 2020  Dale Mellor <mcron-lsfnyl@rdmp.org>
+;;; Copyright © 2015, 2016, 2018  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/>.
+
+
 (unless (getenv "MCRON_UNINSTALLED")
   (set! %load-path (cons "%modsrcdir%" %load-path))
   (set! %load-compiled-path (cons "%modbuilddir%" %load-compiled-path)))
 
-(use-modules (mcron scripts mcron))
+(use-modules  (mcron scripts mcron)
-(main)
+              (ice-9 command-line-processor))
+
+(process-command-line  (command-line)
+       application   "mcron"
+       version       "%VERSION%"
+       usage         "[OPTIONS ...] [FILES ...]"
+       help-preamble
+  "Run unattended jobs according to instructions in the FILES... "
+  "(`-' for standard input), or use all the files in ~/.config/cron "
+  "(or the deprecated ~/.cron) with .guile or .vixie extensions.\n"
+  "Note that --daemon and --schedule are mutually exclusive."
+       option  (--daemon  -d  "run as a daemon process")
+       option  (--schedule=8  -s  string->number
+                      "display the next N (or 8) jobs that will be run,"
+                      "and then exit")
+       option  (--stdin=guile  short-i  (λ (in) (or (string=? in "guile")
+                                                    (string=? in "vixie")))
+                      "format of data passed as standard input or file "
+                      "arguments, 'guile' or 'vixie' (default guile)")
+       help-postamble
+  "Mandatory or optional arguments to long options are also mandatory or "
+  "optional for any corresponding short options."
+       bug-address "%PACKAGE_BUGREPORT%"
+       copyright   "2003, 2006, 2014, 2020  Free Software Foundation, Inc."
+       license     GPLv3)
+
+(main --daemon --schedule --stdin --!)

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)
 

src/mcron/scripts/cron.scm

@@ -19,7 +19,6 @@
 
 
 (define-module (mcron scripts cron)
-  #:use-module (ice-9 getopt-long)
   #:use-module (ice-9 ftw)
   #:use-module (mcron base)
   #:use-module (mcron config)
@@ -31,29 +30,6 @@
 
 
 
-(define (show-help)
-  (display "Usage: cron [OPTIONS]
-Unless an option is specified, run a cron daemon as a detached process,
-reading all the information in the users' crontabs and in /etc/crontab.
-
-  -v, --version             Display version
-  -h, --help                Display this help message
-  -sN, --schedule[=]N       Display the next N jobs that will be run by cron
-  -n, --noetc               Do not check /etc/crontab for updates (HIGHLY
-                              RECOMMENDED).")
-  (newline)
-  (show-package-information))
-
-
-
-(define  %options  `((schedule (single-char #\s) (value #t)
-                               (predicate ,string->number))
-                     (noetc    (single-char #\n) (value #f))
-                     (version  (single-char #\v) (value #f))
-                     (help     (single-char #\h) (value #f))))
-
-
-
 (define (delete-run-file)
   "Remove the /var/run/cron.pid file so that crontab and other invocations of
 cron don't get the wrong idea that a daemon is currently running.  This
@@ -107,10 +83,7 @@ operation.  The permissions on the /var/cron/tabs directory enforce this."
       (mcron-error 4
         "You do not have permission to access the system crontabs."))))
 
-(define (%process-files schedule? noetc?)
+(define (%process-files noetc?)
-  ;; XXX: What is this supposed to do?
-  (when schedule?
-    (with-output-to-file config-pid-file noop))
   ;; Clear MAILTO so that outputs are sent to the various users.
   (setenv "MAILTO" #f)
   ;; Having defined all the necessary procedures for scanning various sets of
@@ -141,17 +114,10 @@ option.\n")
 ;;; Entry point.
 ;;;
 
-(define* (main #:optional (args (command-line)))
+(define (main --schedule --noetc)
-  (let ((opts (getopt-long args %options)))
+    (when  config-debug  (debug-enable 'backtrace))
-    (when config-debug
+
-      (debug-enable 'backtrace))
+    (cond  ((not (zero? (getuid)))
-    (cond  ((option-ref opts 'help #f)
-               (show-help)
-               (exit 0))
-           ((option-ref opts 'version #f)
-               (show-version "cron")
-               (exit 0))
-           ((not (zero? (getuid)))
                (mcron-error 16
                    "This program must be run by the root user (and should"
                    " have been installed as such)."))
@@ -161,12 +127,11 @@ option.\n")
                    " this is not true, remove the file\n   "
                    config-pid-file ".)"))
            (else
-               (%process-files (option-ref opts 'schedule #f)
+               (cond (--schedule
-                               (option-ref opts 'noetc #f))
-               (cond ((option-ref opts 'schedule #f)
                       => (λ (count)
                            (display-schedule (max 1 (string->number count)))
-                           (exit 0)))))))
+                           (exit 0))))
+               (%process-files --noetc)))
 
   ;; Daemonize ourself.
   (unless  (eq? 0 (primitive-fork))  (exit 0))

src/mcron/scripts/crontab.scm

@@ -1,5 +1,5 @@
 ;;;; crontab -- edit user's cron tabs
-;;; Copyright © 2003, 2004 Dale Mellor <dale_mellor@users.sourceforge.net>
+;;; Copyright © 2003, 2004 Dale Mellor <>
 ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
 ;;;
 ;;; This file is part of GNU Mcron.
@@ -18,31 +18,12 @@
 ;;; along with GNU Mcron.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (mcron scripts crontab)
-  #:use-module (ice-9 getopt-long)
   #:use-module (ice-9 rdelim)
   #:use-module (mcron config)
   #:use-module (mcron utils)
   #:use-module (mcron vixie-specification)
   #:export (main))
 
-(define (show-help)
-  (display "Usage: crontab [-u user] file
-       crontab [-u user] { -e | -l | -r }
-               (default operation is replace, per 1003.2)
-       -e      (edit user's crontab)
-       -l      (list user's crontab)
-       -r      (delete user's crontab)")
-  (newline)
-  (show-package-information))
-
-(define %options
-  '((user     (single-char #\u) (value #t))
-    (edit     (single-char #\e) (value #f))
-    (list     (single-char #\l) (value #f))
-    (remove   (single-char #\r) (value #f))
-    (version  (single-char #\v) (value #f))
-    (help     (single-char #\h) (value #f))))
-
 (define (hit-server user-name)
   "Tell the running cron daemon that the user corresponding to
 USER-NAME has modified his crontab.  USER-NAME is written to the
@@ -56,6 +37,25 @@ USER-NAME has modified his crontab.  USER-NAME is written to the
     (lambda (key . args)
       (display "Warning: a cron daemon is not running.\n"))))
 
+
+
+;; Display the prompt and wait for user to type his choice. Return #t if the
+;; answer begins with 'y' or 'Y', return #f if it begins with 'n' or 'N',
+;; otherwise ask again.
+(define  (get-yes-no prompt . re-prompt)
+  (unless (null? re-prompt)
+      (display "Please answer y or n.\n"))
+  (display (string-append prompt " "))
+  (let ((r (read-line)))
+    (if (not (string-null? r))
+        (case (string-ref r 0)
+              ((#\y #\Y) #t)
+              ((#\n #\N) #f)
+              (else (get-yes-no prompt #t)))
+      (get-yes-no prompt #t))))
+
+
+
 (define (in-access-file? file name)
   "Scan FILE which should contain one user name per line (such as
 '/var/cron/allow' and '/var/cron/deny').  Return #t if NAME is in there, and
@@ -78,60 +78,34 @@ USER-NAME has modified his crontab.  USER-NAME is written to the
 ;;; Entry point.
 ;;;
 
-(define* (main #:optional (args (command-line)))
+(define (main --user --edit --list --remove files)
-  (let ((opts (getopt-long args %options)))
+  (when config-debug  (debug-enable 'backtrace))
-    (when config-debug
+  (let ((crontab-real-user
-      (debug-enable 'backtrace))
+         ;; This program should have been installed SUID root. Here we get
-    (cond ((option-ref opts 'help #f)
+         ;; the passwd entry for the real user who is running this program.
-           (show-help)
+         (passwd:name (getpw (getuid)))))
-           (exit 0))
-          ((option-ref opts 'version #f)
-           (show-version "crontab")
-           (exit 0)))
-    (let ((crontab-real-user
-           ;; This program should have been installed SUID root. Here we get
-           ;; the passwd entry for the real user who is running this program.
-           (passwd:name (getpw (getuid)))))
 
-      ;; If the real user is not allowed to use crontab due to the
+    ;; If the real user is not allowed to use crontab due to the
-      ;; /var/cron/allow and/or /var/cron/deny files, bomb out now.
+    ;; /var/cron/allow and/or /var/cron/deny files, bomb out now.
-      (if (or (eq? (in-access-file? config-allow-file crontab-real-user) #f)
+    (if (or (eq? (in-access-file? config-allow-file crontab-real-user) #f)
-              (eq? (in-access-file? config-deny-file crontab-real-user) #t))
+            (eq? (in-access-file? config-deny-file crontab-real-user) #t))
-          (mcron-error 6 "Access denied by system operator."))
+        (mcron-error 6 "Access denied by system operator."))
 
-      ;; Check that no more than one of the mutually exclusive options are
+    ;; Check that no more than one of the mutually exclusive options are
-      ;; being used.
+    ;; being used.
-      (when (> (+ (if (option-ref opts 'edit #f) 1 0)
+      (when (<  1  (+ (if --edit 1 0) (if --list 1 0) (if --remove 1 0)))
-                  (if (option-ref opts 'list #f) 1 0)
-                  (if (option-ref opts 'remove #f) 1 0))
-               1)
         (mcron-error 7 "Only one of options -e, -l or -r can be used."))
 
       ;; Check that a non-root user is trying to read someone else's files.
-      (when (and (not (zero? (getuid)))
+      (when (and (not (zero? (getuid))) --user)
-                 (option-ref opts 'user #f))
         (mcron-error 8 "Only root can use the -u option."))
 
       (letrec* (;; Iff the --user option is given, the crontab-user may be
                 ;; different from the real user.
-                (crontab-user (option-ref opts 'user crontab-real-user))
+                (crontab-user (or --user crontab-real-user))
                 ;; So now we know which crontab file we will be manipulating.
-                (crontab-file (string-append config-spool-dir "/" crontab-user))
+                (crontab-file
-                ;; Display the prompt and wait for user to type his
+                         (string-append config-spool-dir "/" crontab-user)))
-                ;; choice. Return #t if the answer begins with 'y' or 'Y',
-                ;; return #f if it begins with 'n' or 'N', otherwise ask
-                ;; again.
-                (get-yes-no (λ (prompt . re-prompt)
-                              (if (not (null? re-prompt))
-                                  (display "Please answer y or n.\n"))
-                              (display (string-append prompt " "))
-                              (let ((r (read-line)))
-                                (if (not (string-null? r))
-                                    (case (string-ref r 0)
-                                      ((#\y #\Y) #t)
-                                      ((#\n #\N) #f)
-                                      (else (get-yes-no prompt #t)))
-                                    (get-yes-no prompt #t))))))
         ;; There are four possible sub-personalities to the crontab
         ;; personality: list, remove, edit and replace (when the user uses no
         ;; options but supplies file names on the command line).
@@ -140,7 +114,7 @@ USER-NAME has modified his crontab.  USER-NAME is written to the
          ;; character-by-character to the standard output. If anything goes
          ;; wrong, it can only mean that this user does not have a crontab
          ;; file.
-         ((option-ref opts 'list #f)
+         (--list
           (catch #t
             (λ ()
               (with-input-from-file crontab-file
@@ -163,7 +137,7 @@ USER-NAME has modified his crontab.  USER-NAME is written to the
          ;; cron daemon up, and remove the temporary file. If the parse fails,
          ;; we give user a choice of editing the file again or quitting the
          ;; program and losing all changes made.
-         ((option-ref opts 'edit #f)
+         (--edit
           (let ((temp-file (string-append config-tmp-dir
                                           "/crontab."
                                           (number->string (getpid)))))
@@ -191,12 +165,9 @@ USER-NAME has modified his crontab.  USER-NAME is written to the
 
          ;; In the remove personality we simply make an effort to delete the
          ;; crontab and wake the daemon. No worries if this fails.
-         ((option-ref opts 'remove #f)
+         (--remove (catch #t (λ ()  (delete-file crontab-file)
-          (catch #t
+                                    (hit-server crontab-user))
-            (λ ()
+                          noop))
-              (delete-file crontab-file)
-              (hit-server crontab-user))
-            noop))
 
          ;; XXX: This comment is wrong.
          ;; In the case of the replace personality we loop over all the
@@ -206,8 +177,8 @@ USER-NAME has modified his crontab.  USER-NAME is written to the
          ;; location; we deal with the standard input in the same way but
          ;; different. :-) In either case the server is woken so that it will
          ;; read the newly installed crontab.
-         ((not (null? (option-ref opts '() '())))
+         ((not (null? files))
-          (let ((input-file (car (option-ref opts '() '()))))
+          (let ((input-file (car files)))
             (catch-mcron-error
              (if (string=? input-file "-")
                  (let ((input-string (read-string)))
@@ -222,4 +193,4 @@ USER-NAME has modified his crontab.  USER-NAME is written to the
          ;; The user is being silly. The message here is identical to the one
          ;; Vixie cron used to put out, for total compatibility.
          (else (mcron-error 15
-                 "usage error: file name must be specified for replace.")))))))
+                 "usage error: file name must be specified for replace."))))))

src/mcron/scripts/mcron.scm

@@ -1,6 +1,6 @@
 ;;;; mcron -- run jobs at scheduled times
-;;; Copyright © 2003, 2012 Dale Mellor <dale_mellor@users.sourceforge.net>
+;;; Copyright © 2003, 2012, 2020  Dale Mellor <>
-;;; Copyright © 2015, 2016, 2018 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2015, 2016, 2018  Mathieu Lirzin <mthl@gnu.org>
 ;;;
 ;;; This file is part of GNU Mcron.
 ;;;
@@ -19,7 +19,6 @@
 
 (define-module (mcron scripts mcron)
   #:use-module (ice-9 ftw)
-  #:use-module (ice-9 getopt-long)
   #:use-module (ice-9 local-eval)
   #:use-module (ice-9 rdelim)
   #:use-module (mcron base)
@@ -31,28 +30,6 @@
 
 
 
-(define (show-help)
-  (display "Usage: mcron [OPTION...] [FILE...]
-Run an mcron process according to the specifications in the FILE... (`-' for
-standard input), or use all the files in ~/.config/cron (or the deprecated
-~/.cron) with .guile or .vixie extensions.
-
-  -d, --daemon               Run as a daemon process
-  -i, --stdin=(guile|vixie)  Format of data passed as standard input or file
-                             arguments (default guile)
-  -s, --schedule[=N]         Display the next N (or 8) jobs that will be run
-  -?, --help                 Give this help list
-  -V, --version              Print program version
-
-Mandatory or optional arguments to long options are also mandatory or optional
-for any corresponding short options.
-
-Report bugs to bug-mcron@gnu.org.
-
-"))
-
-
-
 (define process-user-file
   (let ((guile-regexp (make-regexp "\\.gui(le)?$"))
         (vixie-regexp (make-regexp "\\.vix(ie)?$")))
@@ -107,38 +84,17 @@ $XDG_CONFIG_HOME is not defined uses ~/.config/cron instead)."
 ;;; Entry point.
 ;;;
 
-(define (main)
+(define (main --daemon --schedule --stdin file-list)
 
-  (let ((options
+    (when  config-debug  (debug-enable 'backtrace))
-            (getopt-long
+    (%process-files   file-list   (or --stdin "guile"))
-                (command-line)
+    (cond (--schedule
-                `((daemon   (single-char #\d) (value #f))
-                  (stdin    (single-char #\i) (value #t)
-                            (predicate ,(λ (in) (or (string=? in "guile")
-                                                    (string=? in "vixie")))))
-                  (schedule (single-char #\s) (value optional)
-                            (predicate ,string->number))
-                  (help     (single-char #\?))
-                  (version  (single-char #\V))))))
-
-    (cond ((option-ref options 'help #f)      (show-help)             (exit 0))
-          ((option-ref options 'version #f)   (show-version "mcron")  (exit 0)))
-  
-    (when config-debug
-      (debug-enable 'backtrace))
-
-    (%process-files (option-ref options '() '())
-                    (option-ref options 'stdin "guile"))
-
-    (cond ((option-ref options 'schedule #f)
                => (λ (count)
-                     (let ((c (if (string? count) (string->number count) 8)))
+                     (display-schedule
-                       (display-schedule  (if (exact-integer? c) (max 1 c) 8)))
+                        (max 1 (inexact->exact (floor (string->number count)))))
                      (exit 0)))
-          ((option-ref options 'daemon #f)
+          (--daemon   (case (primitive-fork)  ((0)  (setsid))
-               (case (primitive-fork)
+                                              (else (exit 0)))))
-                     ((0)  (setsid))
-                     (else (exit 0)))))
 
     ;; Forever execute the 'run-job-loop', and when it drops out (can only be
     ;; because a message has come in on the socket) we process the socket
@@ -150,4 +106,4 @@ $XDG_CONFIG_HOME is not defined uses ~/.config/cron instead)."
          ;; we can also drop out of run-job-loop because of a SIGCHLD,
          ;; so must test FDES-LIST.
          (unless (null? fdes-list)
-           (process-update-request fdes-list)))))))
+           (process-update-request fdes-list))))))

src/mcron/vixie-time.scm

@@ -1,6 +1,6 @@
 ;;;; vixie-time.scm -- parse Vixie-style times
 ;;; Copyright © 2003 Dale Mellor <dale_mellor@users.sourceforge.net>
-;;; Copyright © 2018 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2018, 2020 Mathieu Lirzin <mthl@gnu.org>
 ;;;
 ;;; This file is part of GNU Mcron.
 ;;;
@@ -360,7 +360,7 @@ accounted for."
                                    (time-spec:list wday)
                                    (tm:mon time)
                                    (tm:year time)))))
-             (nudge-day! (pk time) (pk (cddr time-spec-list)))
+             (nudge-day! time (cddr time-spec-list))
              (set-tm:hour time -1))
            (unless (member (tm:hour time)
                            (time-spec:list hour))

tests/redirect.scm

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

tests/vixie-specification.scm

@@ -0,0 +1,144 @@
+;;;; vixie-specification.scm -- tests for (mcron vixie-specificaion) 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 (srfi srfi-1)
+             (srfi srfi-64)
+             (mcron vixie-specification))
+
+(setenv "TZ" "UTC0")
+
+;;; Do not send mail
+(setenv "MAILTO" "")
+
+(define (create-file! content)
+  "Construct a temporary file port containing CONTENT which must be a string."
+  (let ((port (mkstemp! (string-copy "file-XXXXXX"))))
+    (display content port)
+    (force-output port)
+    port))
+
+(define (clean-temp port)
+  "Close and Delete a temporary file port"
+  (let ((fname (port-filename port)))
+    (close port)
+    (delete-file fname)))
+
+(define schedule (@@ (mcron base) %global-schedule))
+(define schedule-user (@@ (mcron base) schedule-user))
+(define set-schedule-user! (@@ (mcron base) set-schedule-user!))
+(define job:environment (@@ (mcron base) job:environment))
+(define job:displayable (@@ (mcron base) job:displayable))
+(define job:user (@@ (mcron base) job:user))
+
+(test-begin "vixie-specification")
+
+;;; Parse user crontab file
+
+(define user-crontab-example
+  "# Example crontab
+FOO=x
+BAR=y
+
+# Example of job definitions:
+17 *	* * *	cd / && run baz
+47 6	* * 7	foo -x /tmp/example || bar
+")
+
+(define user-crontab (create-file! user-crontab-example))
+
+(dynamic-wind
+  (const #t)
+  (lambda ()
+    (set-schedule-user! schedule '())
+    (read-vixie-file (port-filename user-crontab))
+
+    (test-assert "User schedule has exactly 2 matching jobs"
+      (lset= string=?
+             '("cd / && run baz"
+               "foo -x /tmp/example || bar")
+             (map job:displayable (schedule-user schedule))))
+
+    (test-assert "Job environment matches configuration"
+      (every (lambda (j)
+               (lset= equal?
+                      '(("FOO" . "x") ("BAR" . "y"))
+                      (job:environment j)))
+             (schedule-user schedule))))
+
+  (lambda ()
+    (clean-temp user-crontab)))
+
+;;; Parse system crontab file
+
+;;; Get two existing users from the test environment.
+(setpwent)
+(define user0 (getpwent))
+(define user1 (or (getpwent) user0))
+(define system-crontab-example
+  (string-append
+   "# Example crontab
+BAZ=z
+
+17 *	* * * " (passwd:name user0) " cd / && run baz
+47 6	* * 7 "	(passwd:name user1) "   foo -x /tmp/example || bar"))
+
+(define sys-crontab (create-file! system-crontab-example))
+
+(dynamic-wind
+  (const #t)
+  (lambda ()
+    (set-schedule-user! schedule '())
+    (read-vixie-file (port-filename sys-crontab) parse-system-vixie-line)
+
+    (test-assert "System schedule has exactly 2 matching jobs"
+      (lset= equal?
+             `((,user0 . "cd / && run baz")
+               (,user1 . "foo -x /tmp/example || bar"))
+             (map (lambda (j)
+                    (cons (job:user j) (job:displayable j)))
+                  (schedule-user schedule))))
+
+    (test-assert "Job environment matches configuration"
+    (every (lambda (j)
+             (lset= equal? '(("BAZ" . "z")) (job:environment j)))
+           (schedule-user schedule))))
+
+  (lambda ()
+    (clean-temp sys-crontab)))
+
+;;; Try to parse a user crontab in a system context
+
+(define wrong-system-crontab-example
+  "
+# Example of job definitions:
+17 *	* * *	ls")
+
+(define wrong-sys-crontab (create-file! wrong-system-crontab-example))
+
+(dynamic-wind
+  (const #t)
+  (lambda ()
+    (test-error "missing user"
+      'mcron-error
+      (read-vixie-file (port-filename wrong-sys-crontab)
+                       parse-system-vixie-line)))
+
+  (lambda ()
+    (clean-temp wrong-sys-crontab)))
+
+(test-end)