diff --git a/Makefile.am b/Makefile.am
index b5c6260..ddfad07 100755
--- a/Makefile.am
+++ b/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
## -------------- ##
diff --git a/configure.ac b/configure.ac
index 97e9cff..8948c9b 100755
--- a/configure.ac
+++ b/configure.ac
@@ -20,7 +20,7 @@
# along with GNU Mcron. If not, see .
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])
diff --git a/src/cron.in b/src/cron.in
index 25ad273..c22b701 100644
--- a/src/cron.in
+++ b/src/cron.in
@@ -2,9 +2,52 @@
-*- scheme -*-
!#
+;;;; cron -- run jobs at scheduled times
+;;; Copyright © 2003, 2012, 2020 Dale Mellor
+;;; Copyright © 2015, 2016, 2018 Mathieu Lirzin
+;;;
+;;; 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 .
+
+
(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))
-(main)
+(use-modules (mcron scripts cron)
+ (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)
diff --git a/src/crontab.in b/src/crontab.in
index dad0dd2..f203a98 100644
--- a/src/crontab.in
+++ b/src/crontab.in
@@ -2,8 +2,44 @@
-*- scheme -*-
!#
+;;;; crontab -- run jobs at scheduled times
+;;; Copyright © 2003, 2020 Dale Mellor
+;;; Copyright © 2015, 2016, 2018 Mathieu Lirzin
+;;;
+;;; 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 .
+
+
(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 --!)
diff --git a/src/mcron.in b/src/mcron.in
index 268743c..43dc326 100644
--- a/src/mcron.in
+++ b/src/mcron.in
@@ -2,9 +2,55 @@
-*- scheme -*-
!#
+;;;; mcron -- run jobs at scheduled times
+;;; Copyright © 2003, 2012, 2020 Dale Mellor
+;;; Copyright © 2015, 2016, 2018 Mathieu Lirzin
+;;;
+;;; 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 .
+
+
(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))
-(main)
+(use-modules (mcron scripts mcron)
+ (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 --!)
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)
diff --git a/src/mcron/scripts/cron.scm b/src/mcron/scripts/cron.scm
index 25c8a1a..b8463f6 100644
--- a/src/mcron/scripts/cron.scm
+++ b/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?)
- ;; XXX: What is this supposed to do?
- (when schedule?
- (with-output-to-file config-pid-file noop))
+(define (%process-files noetc?)
;; 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)))
- (let ((opts (getopt-long args %options)))
- (when config-debug
- (debug-enable 'backtrace))
- (cond ((option-ref opts 'help #f)
- (show-help)
- (exit 0))
- ((option-ref opts 'version #f)
- (show-version "cron")
- (exit 0))
- ((not (zero? (getuid)))
+(define (main --schedule --noetc)
+ (when config-debug (debug-enable 'backtrace))
+
+ (cond ((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)
- (option-ref opts 'noetc #f))
- (cond ((option-ref opts 'schedule #f)
+ (cond (--schedule
=> (λ (count)
(display-schedule (max 1 (string->number count)))
- (exit 0)))))))
+ (exit 0))))
+ (%process-files --noetc)))
;; Daemonize ourself.
(unless (eq? 0 (primitive-fork)) (exit 0))
diff --git a/src/mcron/scripts/crontab.scm b/src/mcron/scripts/crontab.scm
index 480eadc..0c5c47f 100644
--- a/src/mcron/scripts/crontab.scm
+++ b/src/mcron/scripts/crontab.scm
@@ -1,5 +1,5 @@
;;;; crontab -- edit user's cron tabs
-;;; Copyright © 2003, 2004 Dale Mellor
+;;; Copyright © 2003, 2004 Dale Mellor <>
;;; Copyright © 2016 Mathieu Lirzin
;;;
;;; This file is part of GNU Mcron.
@@ -18,31 +18,12 @@
;;; along with GNU Mcron. If not, see .
(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)))
- (let ((opts (getopt-long args %options)))
- (when config-debug
- (debug-enable 'backtrace))
- (cond ((option-ref opts 'help #f)
- (show-help)
- (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)))))
+(define (main --user --edit --list --remove files)
+ (when config-debug (debug-enable 'backtrace))
+ (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
- ;; /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)
- (eq? (in-access-file? config-deny-file crontab-real-user) #t))
- (mcron-error 6 "Access denied by system operator."))
+ ;; 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.
+ (if (or (eq? (in-access-file? config-allow-file crontab-real-user) #f)
+ (eq? (in-access-file? config-deny-file crontab-real-user) #t))
+ (mcron-error 6 "Access denied by system operator."))
- ;; Check that no more than one of the mutually exclusive options are
- ;; being used.
- (when (> (+ (if (option-ref opts 'edit #f) 1 0)
- (if (option-ref opts 'list #f) 1 0)
- (if (option-ref opts 'remove #f) 1 0))
- 1)
+ ;; Check that no more than one of the mutually exclusive options are
+ ;; being used.
+ (when (< 1 (+ (if --edit 1 0) (if --list 1 0) (if --remove 1 0)))
(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)))
- (option-ref opts 'user #f))
+ (when (and (not (zero? (getuid))) --user)
(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))
- ;; 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.
- (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))))))
+ (crontab-file
+ (string-append config-spool-dir "/" crontab-user)))
;; 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)
- (catch #t
- (λ ()
- (delete-file crontab-file)
- (hit-server crontab-user))
- noop))
+ (--remove (catch #t (λ () (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 '() '())))
- (let ((input-file (car (option-ref opts '() '()))))
+ ((not (null? files))
+ (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."))))))
diff --git a/src/mcron/scripts/mcron.scm b/src/mcron/scripts/mcron.scm
index 0da1cdf..48efae5 100644
--- a/src/mcron/scripts/mcron.scm
+++ b/src/mcron/scripts/mcron.scm
@@ -1,6 +1,6 @@
;;;; mcron -- run jobs at scheduled times
-;;; Copyright © 2003, 2012 Dale Mellor
-;;; Copyright © 2015, 2016, 2018 Mathieu Lirzin
+;;; Copyright © 2003, 2012, 2020 Dale Mellor <>
+;;; Copyright © 2015, 2016, 2018 Mathieu Lirzin
;;;
;;; 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
- (getopt-long
- (command-line)
- `((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)
+ (when config-debug (debug-enable 'backtrace))
+ (%process-files file-list (or --stdin "guile"))
+ (cond (--schedule
=> (λ (count)
- (let ((c (if (string? count) (string->number count) 8)))
- (display-schedule (if (exact-integer? c) (max 1 c) 8)))
+ (display-schedule
+ (max 1 (inexact->exact (floor (string->number count)))))
(exit 0)))
- ((option-ref options 'daemon #f)
- (case (primitive-fork)
- ((0) (setsid))
- (else (exit 0)))))
+ (--daemon (case (primitive-fork) ((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))))))
diff --git a/src/mcron/vixie-time.scm b/src/mcron/vixie-time.scm
index 407ff60..0301434 100644
--- a/src/mcron/vixie-time.scm
+++ b/src/mcron/vixie-time.scm
@@ -1,6 +1,6 @@
;;;; vixie-time.scm -- parse Vixie-style times
;;; Copyright © 2003 Dale Mellor
-;;; Copyright © 2018 Mathieu Lirzin
+;;; Copyright © 2018, 2020 Mathieu Lirzin
;;;
;;; 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))
diff --git a/tests/redirect.scm b/tests/redirect.scm
new file mode 100644
index 0000000..700bfb4
--- /dev/null
+++ b/tests/redirect.scm
@@ -0,0 +1,53 @@
+;;;; redirect.scm -- tests for (mcron redirect) module
+;;; Copyright © 2020 Mathieu Lirzin
+;;;
+;;; 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 .
+
+(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)
diff --git a/tests/vixie-specification.scm b/tests/vixie-specification.scm
new file mode 100644
index 0000000..78c1dad
--- /dev/null
+++ b/tests/vixie-specification.scm
@@ -0,0 +1,144 @@
+;;;; vixie-specification.scm -- tests for (mcron vixie-specificaion) module
+;;; Copyright © 2020 Mathieu Lirzin
+;;;
+;;; 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 .
+
+(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)