From 9781507defd8ddd652653386eddbc5fc371e4742 Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Fri, 8 May 2020 18:43:41 +0200 Subject: [PATCH 1/8] build: Handle missing "bin" directory This fixes the generation of scripts when "bin" directory does not exist. * Makefile.am (bin/%): Invoke $(MKDIR_P) first. --- Makefile.am | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/Makefile.am b/Makefile.am index e8fe80c..f63ff8f 100755 --- a/Makefile.am +++ b/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with automake to produce Makefile.in. # Copyright © 2003 Dale Mellor -# Copyright © 2015, 2016, 2017, 2018 Mathieu Lirzin +# Copyright © 2015, 2016, 2017, 2018, 2020 Mathieu Lirzin # # This file is part of GNU Mcron. # @@ -100,7 +100,8 @@ DISTCLEANFILES = src/mcron/config.scm bin/% : src/%.in Makefile - -@sed -e 's,%PREFIX%,${prefix},g' \ + $(AM_V_GEN)$(MKDIR_P) bin ; \ + sed -e 's,%PREFIX%,${prefix},g' \ -e 's,%modsrcdir%,${guilesitedir},g' \ -e 's,%modbuilddir%,${guilesitegodir},g' \ -e 's,%localstatedir%,${localstatedir},g' \ @@ -112,8 +113,8 @@ bin/% : src/%.in Makefile -e 's,%PACKAGE_NAME%,@PACKAGE_NAME@,g' \ -e 's,%PACKAGE_URL%,@PACKAGE_URL@,g' \ -e 's,%GUILE%,$(GUILE),g' \ - $< > $@; - -@chmod a+x $@ + $< > $@ ; \ + chmod a+x $@ ## ------------ ## From bc18db895064d9d0516b784ecac5270282c21d30 Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Fri, 8 May 2020 18:43:42 +0200 Subject: [PATCH 2/8] build: Distribute script source files This allows 'make distcheck' to succeed. * Makefile.am (EXTRA_DIST): Add script source files. --- Makefile.am | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Makefile.am b/Makefile.am index f63ff8f..b5c6260 100755 --- a/Makefile.am +++ b/Makefile.am @@ -148,6 +148,9 @@ EXTRA_DIST = \ bootstrap \ build-aux/guix.scm \ HACKING \ + src/cron.in \ + src/crontab.in \ + src/mcron.in \ tests/init.sh \ $(TESTS) From 6a9bfcea4080390186be859c721e35f438d1272d Mon Sep 17 00:00:00 2001 From: Dale Mellor Date: Fri, 8 May 2020 20:43:50 +0100 Subject: [PATCH 3/8] Using new Guile command-line-processor. --- src/cron.in | 47 ++++++++++++- src/crontab.in | 38 ++++++++++- src/mcron.in | 50 +++++++++++++- src/mcron/scripts/cron.scm | 51 +++----------- src/mcron/scripts/crontab.scm | 121 +++++++++++++--------------------- src/mcron/scripts/mcron.scm | 66 ++++--------------- 6 files changed, 195 insertions(+), 178 deletions(-) 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/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)))))) From d2143dea3f3d933b4c7f19b738827d6ae2bcfe53 Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Mon, 18 May 2020 12:54:50 +0200 Subject: [PATCH 4/8] vixie-time: Remove calls to 'pk' debugging facility * src/mcron/vixie-time.scm (parse-vixie-time): Remove pk usage --- src/mcron/vixie-time.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) 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)) From 92a940cca55a07efb67c7588bbca99a9fe305025 Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Mon, 18 May 2020 12:54:51 +0200 Subject: [PATCH 5/8] tests: Check (mcron vixie-specification) * tests/vixie-specification.scm: New file. * Makefile.am (TESTS): Register it. --- Makefile.am | 1 + tests/vixie-specification.scm | 144 ++++++++++++++++++++++++++++++++++ 2 files changed, 145 insertions(+) create mode 100644 tests/vixie-specification.scm diff --git a/Makefile.am b/Makefile.am index b5c6260..c7562c5 100755 --- a/Makefile.am +++ b/Makefile.am @@ -138,6 +138,7 @@ TESTS = \ tests/environment.scm \ tests/job-specifier.scm \ tests/utils.scm \ + tests/vixie-specification.scm \ tests/vixie-time.scm ## -------------- ## 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) From 765bfbf4d9e4cd22371313f653cd6431034798f0 Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Mon, 18 May 2020 12:54:52 +0200 Subject: [PATCH 6/8] 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. --- Makefile.am | 1 + src/mcron/redirect.scm | 12 ++++++---- tests/redirect.scm | 53 ++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 62 insertions(+), 4 deletions(-) create mode 100644 tests/redirect.scm diff --git a/Makefile.am b/Makefile.am index c7562c5..ddfad07 100755 --- a/Makefile.am +++ b/Makefile.am @@ -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 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/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) From 833ae20c31d9951e7721bb55441df2630aae4765 Mon Sep 17 00:00:00 2001 From: Dale Mellor Date: Mon, 8 Jun 2020 08:54:35 +0100 Subject: [PATCH 7/8] Version to 1.2.0+dmbcs. --- configure.ac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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]) From 96f31795e8c0cf55fd845f2ec90444a9e69d4e68 Mon Sep 17 00:00:00 2001 From: atsb Date: Thu, 13 Aug 2020 16:25:05 +0200 Subject: [PATCH 8/8] fixes for ubuntu 20.4 --- configure.ac | 2 ++ 1 file changed, 2 insertions(+) diff --git a/configure.ac b/configure.ac index 97e9cff..08a16a7 100755 --- a/configure.ac +++ b/configure.ac @@ -39,6 +39,8 @@ m4_pattern_forbid([^PKG_PROG]) m4_pattern_forbid([^PKG_CHECK]) m4_pattern_forbid([^GUILE_P]) m4_pattern_allow([^GUILE_PKG_ERRORS]) +m4_pattern_allow([^GUILE_PKG]) +m4_pattern_allow([^GUILE_PROGS]) # Check for Guile development files. GUILE_PKG([3.0 2.2 2.0])