Compare commits

...

8 commits

Author SHA1 Message Date
Dale Mellor
833ae20c31 Version to 1.2.0+dmbcs. 2020-06-08 08:54:35 +01:00
Mathieu Lirzin
765bfbf4d9 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.
2020-06-08 08:49:51 +01:00
Mathieu Lirzin
92a940cca5 tests: Check (mcron vixie-specification)
* tests/vixie-specification.scm: New file.
* Makefile.am (TESTS): Register it.
2020-06-08 08:49:37 +01:00
Mathieu Lirzin
d2143dea3f vixie-time: Remove calls to 'pk' debugging facility
* src/mcron/vixie-time.scm (parse-vixie-time): Remove pk usage
2020-06-08 08:49:23 +01:00
Dale Mellor
6a9bfcea40 Using new Guile command-line-processor. 2020-06-08 08:48:57 +01:00
Dale Mellor
f700f299d4 Merge. 2020-06-08 08:45:14 +01:00
Mathieu Lirzin
bc18db8950 build: Distribute script source files
This allows 'make distcheck' to succeed.

* Makefile.am (EXTRA_DIST): Add script source files.
2020-05-08 20:45:16 +01:00
Mathieu Lirzin
9781507def build: Handle missing "bin" directory
This fixes the generation of scripts when "bin" directory does not
exist.

* Makefile.am (bin/%): Invoke $(MKDIR_P) first.
2020-05-08 20:45:16 +01:00
12 changed files with 405 additions and 185 deletions

View file

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

View file

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

View file

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

View file

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

View file

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

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)

View file

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

View file

@ -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)))
(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."))))))

View file

@ -1,6 +1,6 @@
;;;; mcron -- run jobs at scheduled times
;;; Copyright © 2003, 2012 Dale Mellor <dale_mellor@users.sourceforge.net>
;;; Copyright © 2015, 2016, 2018 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2003, 2012, 2020 Dale Mellor <>
;;; 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
(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))))))

View file

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

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)

View file

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