diff options
| -rw-r--r-- | BUGS | 7 | ||||
| -rw-r--r-- | NEWS | 14 | ||||
| -rw-r--r-- | README | 6 | ||||
| -rw-r--r-- | configure.ac | 8 | ||||
| -rw-r--r-- | crontab.scm | 73 | ||||
| -rw-r--r-- | job-specifier.scm | 27 | ||||
| -rw-r--r-- | main.scm | 260 | ||||
| -rw-r--r-- | makefile.am | 2 | ||||
| -rw-r--r-- | mcron-core.scm | 67 | ||||
| -rw-r--r-- | mcron.c.template | 1 | ||||
| -rw-r--r-- | mcron.texinfo.in | 101 | ||||
| -rw-r--r-- | vixie-specification.scm | 77 | ||||
| -rw-r--r-- | vixie-time.scm | 140 |
13 files changed, 476 insertions, 307 deletions
@@ -6,12 +6,7 @@ Please send bug reports to bug-mcron@gnu.org. The currently-known bugs are:- -* Daylight savings time shifts are not taken into account very well. If things - are critical, your best bet is to set your TZ environment variable to - `:Universal', and express all your configuration files in Universal - Coordinated Time (UTC). - - + -NONE- _______________________________________________________________________________ @@ -1,11 +1,20 @@ Historic moments in the life of mcron. -*-text-*- -Copyright (C) 2003 Dale Mellor +Copyright (C) 2003, 2006 Dale Mellor See the end for copying conditions. Please send bug reports to bug-mcron@gnu.org. +Sunday, 16th April 2006 + Released version 1.0.3. Incorporated many coding suggestions by Sergey + Poznyakoff, which makes the program work with daylight savings time shifts, + fixes a bug in parsing Vixie-style input files, allows a user the + opportunity to correct a crontab entry instead of just wiping out the file. + Made it work with Guile 1.8. Updated the manual with GFDL and some minor + suggestions from Karl Berry. + + Monday, 2nd January 2006 Released version 1.0.2. @@ -60,9 +69,8 @@ Friday, 4th July 2003 - ____________________________________________________________________________ -Copyright (C) 2003 Dale Mellor +Copyright (C) 2003, 2006 Dale Mellor Permission is granted to anyone to make or distribute verbatim copies of this document as received, in any medium, provided that the @@ -2,8 +2,7 @@ Copyright (C) 2003 Dale Mellor -*-text-*- See the end for copying conditions. -This is version 1.0.1 of the mcron program, and is the first release as part of -the GNU system which is actually homed at gnu.org. It is designed and written by +This is version 1.0.3 of the GNU mcron program. It is designed and written by Dale Mellor, and replaces and hugely enhances Vixie cron. It is functionally complete, production quality code (did you expect less?), but has not received much testing yet. It has only been built on a GNU/Linux system, and will most @@ -18,7 +17,8 @@ Read the BUGS file. Do not (yet) install this software on a machine which relies for its functioning on its current set of crontabs. -The package must be installed by root. +For use as a replacement cron daemon on a system, the package must be installed +by root. Before installing this package for the first time, it is necessary to terminate any running cron daemons on your system. If your old cron is not Vixie or diff --git a/configure.ac b/configure.ac index 30f8a9f..cf11ad4 100644 --- a/configure.ac +++ b/configure.ac @@ -21,7 +21,7 @@ AC_PREREQ(2.59) -AC_INIT([mcron], [1.0.2], [dale_mellor@users.sourceforge.net]) +AC_INIT([mcron], [1.0.3], [dale_mellor@users.sourceforge.net]) AM_INIT_AUTOMAKE @@ -74,12 +74,12 @@ fi # Check the Guile version. -AC_MSG_CHECKING(for guile version >= 1.6.4) +AC_MSG_CHECKING(for guile version >= 1.8.0) if [$GUILE --version | $HEAD -1 | $AWK '{print $2}' | \ - $EGREP -q '^(1\.(6\.([4-9]|[1-3][^.])|[7-9]|[1-5][^.])|[2-9])']; then + $EGREP -q '^1\.8\.']; then AC_MSG_RESULT(OK) else - AC_MSG_ERROR([Sorry, Guile 1.6.4 or greater is needed to run mcron]) + AC_MSG_ERROR([Sorry, Guile 1.8.0 or greater is needed to run mcron]) fi diff --git a/crontab.scm b/crontab.scm index e5dfa29..96d8b3c 100644 --- a/crontab.scm +++ b/crontab.scm @@ -67,9 +67,7 @@ (if (or (eq? (in-access-file? config-allow-file crontab-real-user) #f) (eq? (in-access-file? config-deny-file crontab-real-user) #t)) - (begin - (display "Access denied by system operator.\n") - (primitive-exit 6))) + (mcron-error 6 "Access denied by system operator.")) @@ -79,9 +77,7 @@ (if (option-ref options 'list #f) 1 0) (if (option-ref options 'remove #f) 1 0)) 1) - (begin - (display "crontab: Only one of options -e, -l or -r can be used.\n") - (primitive-exit 7))) + (mcron-error 7 "Only one of options -e, -l or -r can be used.")) @@ -89,8 +85,7 @@ (if (and (not (eqv? (getuid) 0)) (option-ref options 'user #f)) - (begin (display "crontab: Only root can use the -u option.\n") - (primitive-exit 8))) + (mcron-error 8 "Only root can use the -u option.")) @@ -107,6 +102,24 @@ +;; 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) + (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). @@ -136,7 +149,9 @@ ;; it; once the editor returns we try to read the file to check that it is ;; parseable (but do nothing more with the configuration), and if it is okay ;; (this program is still running!) we move the temporary file to the real - ;; crontab, wake the cron daemon up, and remove the temporary file. + ;; crontab, wake 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 options 'edit #f) (let ((temp-file (string-append config-tmp-dir @@ -145,10 +160,20 @@ (catch #t (lambda () (copy-file crontab-file temp-file)) (lambda (key . args) (with-output-to-file temp-file noop))) (chown temp-file (getuid) (getgid)) - (system (string-append (or (getenv "VISUAL") (getenv "EDITOR") "vi") - " " - temp-file)) - (read-vixie-file temp-file) + (let retry () + (system (string-append + (or (getenv "VISUAL") (getenv "EDITOR") "vi") + " " + temp-file)) + (catch 'mcron-error + (lambda () (read-vixie-file temp-file)) + (lambda (key exit-code . msg) + (apply mcron-error 0 msg) + (if (get-yes-no "Edit again?") + (retry) + (begin + (mcron-error 0 "Crontab not changed") + (primitive-exit 0)))))) (copy-file temp-file crontab-file) (delete-file temp-file) (hit-server crontab-user))) @@ -174,20 +199,20 @@ ((not (null? (option-ref options '() '()))) (let ((input-file (car (option-ref options '() '())))) - (if (string=? input-file "-") - (let ((input-string (stdin->string))) - (read-vixie-port (open-input-string input-string)) - (with-output-to-file crontab-file (lambda () - (display input-string)))) - (begin - (read-vixie-file input-file) - (copy-file input-file crontab-file)))) - (hit-server crontab-user)) + (catch-mcron-error + (if (string=? input-file "-") + (let ((input-string (stdin->string))) + (read-vixie-port (open-input-string input-string)) + (with-output-to-file crontab-file (lambda () + (display input-string)))) + (begin + (read-vixie-file input-file) + (copy-file input-file crontab-file)))) + (hit-server crontab-user))) ;; The user is being silly. The message here is identical to the one Vixie cron ;; used to put out, for total compatibility. (else - (display "crontab: usage error: file name must be specified for replace.\n") - (primitive-exit 15))) + (mcron-error 15 "usage error: file name must be specified for replace."))) diff --git a/job-specifier.scm b/job-specifier.scm index fd4d11b..52e655f 100644 --- a/job-specifier.scm +++ b/job-specifier.scm @@ -233,9 +233,10 @@ ((list? action) (lambda () (primitive-eval action))) ((string? action) (lambda () (system action))) (else - (display "job: invalid second argument (action; should be lamdba") - (display "function, string or list)\n") - (primitive-exit 2)))) + (throw 'mcron-error + 2 + "job: invalid second argument (action; should be lambda" + " function, string or list)")))) (time-proc (cond ((procedure? time-proc) time-proc) @@ -243,9 +244,10 @@ ((list? time-proc) (lambda (current-time) (primitive-eval time-proc))) (else - (display "job: invalid first argument (next-time-function; should ") - (display "be function, string or list)") - (primitive-exit 3)))) + (throw 'mcron-error + 3 + "job: invalid first argument (next-time-function; should ") + "be function, string or list)"))) (displayable (cond ((not (null? displayable)) (car displayable)) ((procedure? action) "Lambda function") @@ -253,8 +255,17 @@ ((list? action) (with-output-to-string (lambda () (display action))))))) (add-job (lambda (current-time) - (set! current-action-time current-time) ;; ?? !!!! - (time-proc current-time)) + (set! current-action-time current-time) ;; ?? !!!! Code + + ;; Contributed by Sergey Poznyakoff to allow for daylight savings + ;; time changes. + (let* ((next (time-proc current-time)) + (gmtoff (tm:gmtoff (localtime next))) + (d (+ next (- gmtoff + (tm:gmtoff (localtime current-time)))))) + (if (eqv? (tm:gmtoff (localtime d)) gmtoff) + d + next))) action displayable configuration-time @@ -43,13 +43,39 @@ ;; backwards for the first non-alphabetic character. This allows names like ;; in.cron to be accepted as an invocation of the cron command. -(use-modules (ice-9 regex)) +(use-modules (ice-9 regex) (ice-9 rdelim)) (define command-name (match:substring (regexp-exec (make-regexp "[[:alpha:]]*$") (car (command-line))))) +;; Code contributed by Sergey Poznyakoff. Print an error message (made up from +;; the parts of rest), and if the error is fatal (present and non-zero) then +;; exit to the system with this code. + +(define (mcron-error exit-code . rest) + (with-output-to-port (current-error-port) + (lambda () + (for-each display (append (list command-name ": ") rest)) + (newline))) + (if (and exit-code (not (eq? exit-code 0))) + (primitive-exit exit-code))) + + + +;; Code contributed by Sergey Poznyakoff. Execute body. If an 'mcron-error +;; exception occurs, print its diagnostics and exit with its error code. + +(defmacro catch-mcron-error (. body) + `(catch 'mcron-error + (lambda () + ,@body) + (lambda (key exit-code . msg) + (apply mcron-error exit-code msg)))) + + + ;; We will be doing a lot of testing of the command name, so it makes sense to ;; perform the string comparisons once and for all here. @@ -58,8 +84,7 @@ (string=? command-name "crond")) 'cron) ((string=? command-name "crontab") 'crontab) (else - (display "The command name is invalid.\n") - (primitive-exit 12)))) + (mcron-error 12 "The command name is invalid.")))) @@ -70,26 +95,34 @@ (use-modules (ice-9 getopt-long)) (define options - (getopt-long (command-line) - (append - (case command-type ('crontab - '((user (single-char #\u) (value #t)) - (edit (single-char #\e) (value #f)) - (list (single-char #\l) (value #f)) - (remove (single-char #\r) (value #f)))) - (else `((schedule (single-char #\s) (value optional)) - (daemon (single-char #\d) (value #f)) - (noetc (single-char #\n) (value #f)) - (stdin (single-char #\i) (value #t) - (predicate - ,(lambda (value) + (catch + 'misc-error + (lambda () + (getopt-long (command-line) + (append + (case command-type + ((crontab) + '((user (single-char #\u) (value #t)) + (edit (single-char #\e) (value #f)) + (list (single-char #\l) (value #f)) + (remove (single-char #\r) (value #f)))) + (else `((schedule (single-char #\s) + (value optional) + (predicate ;; Added by Sergey Poznyakoff. + ,(lambda (value) + (or (eq? value #t) + (string->number value))))) + (daemon (single-char #\d) (value #f)) + (noetc (single-char #\n) (value #f)) + (stdin (single-char #\i) (value #t) + (predicate + ,(lambda (value) (or (string=? "vixie" value) (string=? "guile" value)))))))) - '((version (single-char #\v) (value #f)) - (help (single-char #\h) (value #f)))))) - - - + '((version (single-char #\v) (value #f)) + (help (single-char #\h) (value #f)))))) + (lambda (key func fmt args . rest) + (mcron-error 1 (apply format (append (list #f fmt) args)))))) ;; If the user asked for the version of this program, give it to him and get ;; out. @@ -100,7 +133,7 @@ " command-name " (" config-package-string ")\n Written by Dale Mellor\n \n -Copyright (C) 2003 Dale Mellor\n +Copyright (C) 2003, 2006 Dale Mellor\n This is free software; see the source for copying conditions. There is NO\n warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n ")) @@ -114,7 +147,9 @@ warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n (begin (display (string-append " Usage: " (car (command-line)) -(case command-type ('mcron +(case command-type + + ((mcron) " [OPTIONS] [FILES]\n Run an mcron process according to the specifications in the FILES (`-' for\n standard input), or use all the files in ~/.cron with .guile or .vixie\n @@ -126,10 +161,10 @@ extensions.\n will be run by mcron\n -d, --daemon Immediately detach the program from the terminal and\n run as a daemon process\n - -i, --stdin=(guile|vixie) Format of data passed as standard input\n - (default guile)") + -i, --stdin=(guile|vixie) Format of data passed as standard input or\n + file arguments (default guile)") - ('cron + ((cron) " [OPTIONS]\n Unless an option is specified, run a cron daemon as a detached process, \n reading all the information in the users' crontabs and in /etc/crontab.\n @@ -141,13 +176,15 @@ reading all the information in the users' crontabs and in /etc/crontab.\n -n, --noetc Do not check /etc/crontab for updates (HIGHLY\n RECOMMENDED).") - ('crontab + ((crontab) (string-append " [-u user] file\n" " " (car (command-line)) " [-u user] { -e | -l | -r }\n" " (default operation is replace, per 1003.2)\n" " -e (edit user's crontab)\n" " -l (list user's crontab)\n" - " -r (delete user's crontab)\n"))) + " -r (delete user's crontab)\n")) + + (else "rubbish")) "\n\n Report bugs to " config-package-bugreport ".\n @@ -158,7 +195,7 @@ Report bugs to " config-package-bugreport ".\n ;; This is called from the C front-end whenever a terminal signal is ;; received. We remove the /var/run/cron.pid file so that crontab and other -;; invokations of cron don't get the wrong idea that a daemon is currently +;; invocations of cron don't get the wrong idea that a daemon is currently ;; running. (define (delete-run-file) @@ -183,16 +220,16 @@ Report bugs to " config-package-bugreport ".\n (if (eq? command-type 'cron) (begin (if (not (eqv? (getuid) 0)) - (begin - (display "This program must be run by the root user (and should ") - (display "have been installed as such).\n") - (primitive-exit 16))) + (mcron-error 16 + "This program must be run by the root user (and should " + "have been installed as such).")) (if (access? config-pid-file F_OK) - (begin - (display "A cron daemon is already running.\n") - (display " (If you are sure this is not true, remove the file\n") - (display " " config-pid-file ".)\n") - (primitive-exit 1))) + (mcron-error 1 + "A cron daemon is already running.\n" + " (If you are sure this is not true, remove the file\n" + " " + config-pid-file + ".)")) (if (not (option-ref options 'schedule #f)) (with-output-to-file config-pid-file noop)) (setenv "MAILTO" #f) @@ -230,6 +267,19 @@ Report bugs to " config-package-bugreport ".\n +;; Code contributed by Sergey Poznyakoff. Determine if the given file is a +;; regular file or not. + +(define (regular-file? file) + (catch 'system-error + (lambda () + (eq? (stat:type (stat file)) 'regular)) + (lambda (key call fmt args . rest) + (mcron-error 0 (apply format (append (list #f fmt) args))) + #f))) + + + ;; Procedure which processes any configuration file according to the ;; extension. If a file is not recognized, it is silently ignored (this deals ;; properly with most editors' backup files, for instance). @@ -259,12 +309,12 @@ Report bugs to " config-package-bugreport ".\n (directory (opendir dir-path))) (do ((file-name (readdir directory) (readdir directory))) ((eof-object? file-name) (closedir directory)) - (process-user-file (string-append dir-path - "/" - file-name))))) + (process-user-file (string-append dir-path + "/" + file-name))))) (lambda (key . args) - (display "Cannot read files in your ~/.cron directory.\n") - (primitive-exit 13)))) + (mcron-error 13 "Cannot read files in your ~/.cron directory.")))) + @@ -293,18 +343,21 @@ Report bugs to " config-package-bugreport ".\n (use-modules (srfi srfi-2)) ;; For and-let*. (define (process-files-in-system-directory) - (catch #t (lambda () - (let ((directory (opendir config-spool-dir))) - (do ((file-name (readdir directory) (readdir directory))) - ((eof-object? file-name)) - (and-let* ((user (valid-user file-name))) - (set-configuration-user user) ;; / ?? !!!! - (read-vixie-file (string-append config-spool-dir - "/" - file-name)))))) - (lambda (key . args) - (display "You do not have permission to access the system crontabs.\n") - (primitive-exit 4)))) + (catch #t + (lambda () + (let ((directory (opendir config-spool-dir))) + (do ((file-name (readdir directory) (readdir directory))) + ((eof-object? file-name)) + (and-let* ((user (valid-user file-name))) + (set-configuration-user user) ;; / ?? !!!! + (catch-mcron-error + (read-vixie-file (string-append config-spool-dir + "/" + file-name))))))) + (lambda (key . args) + (mcron-error + 4 + "You do not have permission to access the system crontabs.")))) @@ -316,27 +369,28 @@ Report bugs to " config-package-bugreport ".\n ;; /var/cron/tabs directory and also the /etc/crontab file. (case command-type - ('mcron (if (null? (option-ref options '() '())) - (process-files-in-user-directory) - (for-each (lambda (file-path) - (process-user-file file-path)) - (option-ref options '() '())))) - - ('cron (process-files-in-system-directory) - (use-system-job-list) - (read-vixie-file "/etc/crontab" parse-system-vixie-line) - (use-user-job-list) - (if (not (option-ref options 'noetc #f)) - (begin - (display -"WARNING: cron will check for updates to /etc/crontab EVERY MINUTE. If you do\n + ((mcron) (if (null? (option-ref options '() '())) + (process-files-in-user-directory) + (for-each (lambda (file-path) + (process-user-file file-path)) + (option-ref options '() '())))) + + ((cron) (process-files-in-system-directory) + (use-system-job-list) + (catch-mcron-error + (read-vixie-file "/etc/crontab" parse-system-vixie-line)) + (use-user-job-list) + (if (not (option-ref options 'noetc #f)) + (begin + (display + "WARNING: cron will check for updates to /etc/crontab EVERY MINUTE. If you do\n not use this file, or you are prepared to manually restart cron whenever you\n make a change, then it is HIGHLY RECOMMENDED that you use the --noetc\n option.\n") - (set-configuration-user "root") - (job '(- (next-minute-from (next-minute)) 6) - check-system-crontab - "/etc/crontab update checker."))))) + (set-configuration-user "root") + (job '(- (next-minute-from (next-minute)) 6) + check-system-crontab + "/etc/crontab update checker."))))) @@ -380,10 +434,18 @@ option.\n") (define fd-list '()) (if (eq? command-type 'cron) - (let ((socket (socket AF_UNIX SOCK_STREAM 0))) - (bind socket AF_UNIX config-socket-file) - (listen socket 5) - (set! fd-list (list socket)))) + (catch #t + (lambda () + (let ((socket (socket AF_UNIX SOCK_STREAM 0))) + (bind socket AF_UNIX config-socket-file) + (listen socket 5) + (set! fd-list (list socket)))) + (lambda (key . args) + (delete-file config-pid-file) + (mcron-error 1 + "Cannot bind to UNIX socket " + config-socket-file)))) + @@ -398,23 +460,39 @@ option.\n") (user-name (read-line socket))) (close socket) (set-configuration-time (current-time)) - (if (string=? user-name "/etc/crontab") - (begin - (clear-system-jobs) - (use-system-job-list) - (read-vixie-file "/etc/crontab" parse-system-vixie-line) - (use-user-job-list)) - (let ((user (getpw user-name))) - (remove-user-jobs user) - (set-configuration-user user) - (read-vixie-file (string-append config-spool-dir "/" user-name)))))) + (catch-mcron-error + (if (string=? user-name "/etc/crontab") + (begin + (clear-system-jobs) + (use-system-job-list) + (read-vixie-file "/etc/crontab" parse-system-vixie-line) + (use-user-job-list)) + (let ((user (getpw user-name))) + (remove-user-jobs user) + (set-configuration-user user) + (read-vixie-file (string-append config-spool-dir "/" user-name))))))) + + + +;; Added by Sergey Poznyakoff. This no-op will collect zombie child processes +;; as soon as they die. This is a big improvement as previously they stayed +;; around the system until the next time mcron wakes to fire a new job off. + +;; Unfortunately it seems to interact badly with the select system call, +;; wreaking havoc... + +;; (sigaction SIGCHLD (lambda (sig) noop) SA_RESTART) ;; Now the main loop. Forever execute the run-job-loop procedure in the mcron ;; core, and when it drops out (can only be because a message has come in on the ;; socket) we process the socket request before restarting the loop again. - -(while #t - (run-job-loop fd-list) - (process-update-request)) +;; Sergey Poznyakoff: we can also drop out of run-job-loop because of a SIGCHLD, +;; so must test fd-list. + +(catch-mcron-error + (while #t + (run-job-loop fd-list) + (if (not (null? fd-list)) + (process-update-request)))) diff --git a/makefile.am b/makefile.am index 1bc2d94..b3d32d8 100644 --- a/makefile.am +++ b/makefile.am @@ -20,7 +20,7 @@ ED = @ED@ # !!!! Are these needed? CP = @CP@ -MAINTAINERCLEANFILES = configure makefile makefile.in \ +MAINTAINERCLEANFILES = configure makefile makefile.in config.guess config.sub \ install-sh missing mkinstalldirs texinfo.tex INSTALL \ aclocal.m4 compile depcomp COPYING diff --git a/mcron-core.scm b/mcron-core.scm index 631311a..b8ca289 100644 --- a/mcron-core.scm +++ b/mcron-core.scm @@ -167,7 +167,7 @@ ((eqv? count 0)) (and-let* ((next-jobs (find-next-jobs)) (time (car next-jobs)) - (date-string (strftime "%c\n" (localtime time)))) + (date-string (strftime "%c %z\n" (localtime time)))) (for-each (lambda (job) (display date-string) (display (job:displayable job)) @@ -214,6 +214,16 @@ +;; Give any zombie children a chance to die, and decrease the number known to +;; exist. + +(define (child-cleanup) + (do () ((or (<= number-children 0) + (eqv? (car (waitpid WAIT_ANY WNOHANG)) 0))) + (set! number-children (- number-children 1)))) + + + ;; Now the main loop. Loop over all job specifications, get a list of the next ;; ones to run (may be more than one). Set an alarm and go to sleep. When we ;; wake, run the jobs and reap any children (old jobs) that have @@ -227,26 +237,35 @@ (define (run-job-loop . fd-list) - (call-with-current-continuation (lambda (break) - - (let ((fd-list (if (null? fd-list) '() (car fd-list)))) - - (let loop () - - (let* ((next-jobs (find-next-jobs)) - (next-time (car next-jobs)) - (next-jobs-list (cdr next-jobs)) - (sleep-time (if next-time (- next-time (current-time)) - 2000000000))) - - (and (> sleep-time 0) - (if (not (null? (car (select fd-list '() '() sleep-time)))) - (break))) - - (run-jobs next-jobs-list) - - (do () ((or (<= number-children 0) - (eqv? (car (waitpid WAIT_ANY WNOHANG)) 0))) - (set! number-children (- number-children 1))) - - (loop))))))) + (call-with-current-continuation + (lambda (break) + + (let ((fd-list (if (null? fd-list) '() (car fd-list)))) + + (let loop () + + (let* ((next-jobs (find-next-jobs)) + (next-time (car next-jobs)) + (next-jobs-list (cdr next-jobs)) + (sleep-time (if next-time (- next-time (current-time)) + 2000000000))) + + (and (> sleep-time 0) + (if (not (null? + (catch 'system-error + (lambda () + (car (select fd-list '() '() sleep-time))) + (lambda (key . args) ;; Exception add by Sergey + ;; Poznyakoff. + (if (member (car (last args)) + (list EINTR EAGAIN)) + (begin + (child-cleanup) '()) + (apply throw key args)))))) + (break))) + + (run-jobs next-jobs-list) + + (child-cleanup) + + (loop))))))) diff --git a/mcron.c.template b/mcron.c.template index 4612f67..d9b1b16 100644 --- a/mcron.c.template +++ b/mcron.c.template @@ -53,6 +53,7 @@ +#include <string.h> #include <signal.h> #include <libguile.h> diff --git a/mcron.texinfo.in b/mcron.texinfo.in index ce4c11a..9bc4084 100644 --- a/mcron.texinfo.in +++ b/mcron.texinfo.in @@ -1,36 +1,28 @@ \input texinfo @c %**start of header @setfilename mcron.info -@settitle mcron 1.0.2 +@settitle mcron @VERSION@ @c %**end of header @syncodeindex fn cp -@copying -Copyright (C) 2003, 2005 Dale Mellor -This is free software. See the source files for the terms of the -copyright. - -@ignore -Permission is granted to make and distribute verbatim copies of -this manual provided the copyright notice and this permission notice -are preserved on all copies. - -Permission is granted to process this file through TeX and print the -results, provided the printed document carries copying permission -notice identical to this one except for the removal of this paragraph -(this paragraph not being relevant to the printed manual). - -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided that the entire -resulting derived work is distributed under the terms of a permission -notice identical to this one. - -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions, -except that this permission notice may be stated in a translation approved -by the Foundation. -@end ignore +@copying This manual is for GNU mcron (version @VERSION@), which is a +program for running jobs at scheduled times. + +Copyright @copyright{} 2003, 2005, 2006 Dale Mellor + +@quotation +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.1 or +any later version published by the Free Software Foundation; with no +Invariant Sections, with the Front-Cover Texts being ``A GNU Manual,'' +and with the Back-Cover Texts as in (a) below. A copy of the +license is included in the section entitled ``GNU Free Documentation +License.'' + +(a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify +this GNU Manual, like GNU software.'' +@end quotation @end copying @@ -105,9 +97,9 @@ Vixie Detailed invoking -* Running mcron:: -* Running cron or crond:: -* Running crontab:: +* Invoking mcron:: +* Invoking cron or crond:: +* Invoking crontab:: * Behaviour on laptops:: * Exit codes:: @@ -140,7 +132,10 @@ time of the next command is computed. Furthermore, the specifications are written in scheme, allowing at the same time simple command execution instructions and very much more flexible ones to be composed than the original Vixie format. This has several useful advantages -over the original idea. +over the original idea. (Changes to user crontabs are signalled +directly to mcron by the crontab program; cron must still scan the +/etc/crontab file once every minute, although use of this file is +highly discouraged and this behaviour can be turned off). @cindex advantages of mcron @itemize @bullet @@ -179,7 +174,8 @@ more flexibility, and complete compatibility with Vixie cron. @end itemize A full discussion of the design and philosophy of mcron can be found -in the white paper at http://www.gnu.org/software/mcron/design.html. +in the white paper at +@url{http://www.gnu.org/software/mcron/design.html}. @node Simple examples, Syntax, Introduction, Top @@ -259,7 +255,7 @@ Alternatively (full compatibility with Vixie cron), set your environment variable @code{EDITOR} to your favorite editor, run @code{crontab -e}, put the above line into the edit buffer, save and exit. For this to work the @code{cron} daemon must be already running -on your system, by root. +on your system, as root. @node Syntax, Invoking, Simple examples, Top @chapter Full available syntax @@ -441,17 +437,6 @@ the student to understand how this works!). "my-program") @end example -@cindex daylight savings time -Note that this example is also instructive in that it demonstrates -mcron's indeterminacy when the clocks are adjusted for summertime; use -the @code{-s 12} option to @code{mcron}, and see the off-by-one hour -error that occurs twice a year. This is a known problem, that -daylight savings time shifts are not taken into account very well. If -things are critical, your best bet is to set your TZ environment -variable to `:Universal', and express all your configuration files in -Universal Coordinated Time (UTC). - - @node Two hours every day, Missing the first appointment, Every second Sunday, Extended Guile examples @subsection Two hours every day @@ -590,7 +575,7 @@ user. @node Crontab file, Incompatibilities with old Unices, Paul Vixie's copyright, Vixie Syntax -@subsection Crontab files. +@subsection Crontab files @cindex crontab file @cindex vixie crontab file A @code{crontab} file contains instructions to the @code{cron} daemon @@ -745,7 +730,7 @@ MAILTO=paul @end example @node Incompatibilities with old Unices, , Crontab file, Vixie Syntax -@subsection Extensions and incompatibilities. +@subsection Extensions and incompatibilities @cindex incompatibilities with old Unices @cindex extensions, vixie over old Unices This section lists differences between Paul Vixie's cron and the @@ -813,15 +798,15 @@ place in the part which implements the mcron personality. @menu -* Running mcron:: -* Running cron or crond:: -* Running crontab:: +* Invoking mcron:: +* Invoking cron or crond:: +* Invoking crontab:: * Behaviour on laptops:: * Exit codes:: @end menu -@node Running mcron, Running cron or crond, Invoking, Invoking -@section Running mcron +@node Invoking mcron, Invoking cron or crond, Invoking, Invoking +@section Invoking mcron @cindex invoking mcron @cindex mcron options @cindex mcron arguments @@ -903,12 +888,12 @@ standard output. @end table -@node Running cron or crond, Running crontab, Running mcron, Invoking -@section Running cron or crond +@node Invoking cron or crond, Invoking crontab, Invoking mcron, Invoking +@section Invoking cron or crond @cindex cron, invokation -@cindex running cron +@cindex invoking cron @cindex crond, invokation -@cindex running crond +@cindex invoking crond @cindex @CONFIG_SPOOL_DIR@ @cindex @CONFIG_SOCKET_FILE@ NOTE THAT THIS SECTION ONLY APPLIES IF THE @code{cron} or @@ -979,10 +964,10 @@ recommended that this option be used (and further that the @end table -@node Running crontab, Behaviour on laptops, Running cron or crond, Invoking -@section Running crontab +@node Invoking crontab, Behaviour on laptops, Invoking cron or crond, Invoking +@section Invoking crontab @cindex crontab, invoking -@cindex running crontab +@cindex invoking crontab This program is run by individual users to inspect or modify their crontab files. If a change is made to the file, then the root daemon process will be given a kick, and will immediately read the new @@ -1046,7 +1031,7 @@ become immediately effective. @end table -@node Behaviour on laptops, Exit codes, Running crontab, Invoking +@node Behaviour on laptops, Exit codes, Invoking crontab, Invoking @section Behaviour on laptops @cindex laptops @cindex power suspend diff --git a/vixie-specification.scm b/vixie-specification.scm index 08a8699..0bf4328 100644 --- a/vixie-specification.scm +++ b/vixie-specification.scm @@ -54,8 +54,8 @@ (define (parse-user-vixie-line line) (let ((match (regexp-exec parse-user-vixie-line-regexp line))) - (if (not match) (begin (display "Bad job line in Vixie file.\n") - (primitive-exit 10))) + (if (not match) + (throw 'mcron-error 10 "Bad job line in Vixie file.")) (job (match:substring match 1) (lambda () (with-mail-out (match:substring match 3))) (match:substring match 3)))) @@ -71,8 +71,8 @@ (define (parse-system-vixie-line line) (let ((match (regexp-exec parse-system-vixie-line-regexp line))) - (if (not match) (begin (display "Bad job line in /etc/crontab.\n") - (primitive-exit 11))) + (if (not match) + (throw 'mcron-error 11 "Bad job line in /etc/crontab.")) (let ((user (match:substring match 3))) (set-configuration-user user) (job (match:substring match 1) @@ -92,7 +92,7 @@ "^[ \t]*([[:alpha:]_][[:alnum:]_]*)[ \t]*=[ \t]*\"(.*)\"[ \t]*$")) (define parse-vixie-environment-regexp2 (make-regexp - "^[ \t]*([[:alpha:]_][[:alnum:]_]*)[ \t]*=[ \t]*\'(.*)\'[ \t]*$")) + "^[ \t]*([[:alpha:]_][[:alnum:]_]*)[ \t]*=[ \t]*'(.*)'[ \t]*$")) (define parse-vixie-environment-regexp3 (make-regexp "^[ \t]*([[:alpha:]_][[:alnum:]_]*)[ \t]*=[ \t]*(.*[^ \t])[ \t]*$")) @@ -136,26 +136,39 @@ (let ((parse-vixie-line (if (null? parse-vixie-line) parse-user-vixie-line (car parse-vixie-line)))) - (do ((line (read-line port) (read-line port))) + (do ((line (read-line port) (read-line port)) + (line-number 1 (1+ line-number))) ((eof-object? line)) - - ;; If the line ends with \, append the next line. - (while (and (>= (string-length line) 1) - (char=? (string-ref line - (- (string-length line) 1)) - #\\)) - (let ((next-line (read-line port))) - (if (eof-object? next-line) - (set! next-line "")) - (set! line - (string-append - (substring line 0 (- (string-length line) 1)) - next-line)))) - - ;; Consider the three cases mentioned in the description. - (or (regexp-exec read-vixie-file-comment-regexp line) - (parse-vixie-environment line) - (parse-vixie-line line)))))) + + (let ((report-line line-number)) + ;; If the line ends with \, append the next line. + (while (and (>= (string-length line) 1) + (char=? (string-ref line + (- (string-length line) 1)) + #\\)) + (let ((next-line (read-line port))) + (if (eof-object? next-line) + (set! next-line "")) + (set! line-number (1+ line-number)) + (set! line + (string-append + (substring line 0 (- (string-length line) 1)) + next-line)))) + + (catch 'mcron-error + (lambda () + ;; Consider the three cases mentioned in the description. + (or (regexp-exec read-vixie-file-comment-regexp line) + (parse-vixie-environment line) + (parse-vixie-line line))) + (lambda (key exit-code . msg) + (throw + 'mcron-error + exit-code + (apply string-append + (number->string report-line) + ": " + msg))))))))) @@ -168,12 +181,16 @@ (catch #t (lambda () (set! port (open-input-file file-path))) (lambda (key . args) (set! port #f))) (if port - (begin - (if (null? parse-vixie-line) - (read-vixie-port port) - (read-vixie-port port (car parse-vixie-line))) - (close port))))) - + (catch 'mcron-error + (lambda () + (if (null? parse-vixie-line) + (read-vixie-port port) + (read-vixie-port port (car parse-vixie-line))) + (close port)) + (lambda (key exit-code . msg) + (close port) + (throw 'mcron-error exit-code + (apply string-append file-path ":" msg))))))) ;; A procedure which determines if the /etc/crontab file has been recently diff --git a/vixie-time.scm b/vixie-time.scm index 164a8de..f8b74d1 100644 --- a/vixie-time.scm +++ b/vixie-time.scm @@ -92,8 +92,8 @@ 1)) ;; [1] (let ((match (regexp-exec parse-vixie-subelement-regexp string))) (cond ((not match) - (display "Error: Bad Vixie-style time specification.\n") - (primitive-exit 9)) + (throw 'mcron-error 9 + "Bad Vixie-style time specification.")) ((match:substring match 5) (range (string->number (match:substring match 1)) (+ 1 (string->number (match:substring match 3))) @@ -271,7 +271,14 @@ ;; ;; We start by computing a list of time-spec objects (described above) for the ;; minute, hour, date, month, year and weekday components of the overall time -;; specification [1]. When we create the return procedure, it is this list to +;; specification [1]. Special care is taken to produce proper values for +;; fields 2 and 4: according to Vixie specification "If both fields are +;; restricted (ie, aren't *), the command will be run when _either_ field +;; matches the current time." This implies that if one of these fields is *, +;; while the other is not, its value should be '() [0], otherwise +;; interpolate-weekdays below will produce incorrect results. + +;; When we create the return procedure, it is this list to ;; which references to a time-spec-list will be bound. It will be used by the ;; returned procedure [3] to compute the next time a function should run. Any ;; 7's in the weekday component of the list (the last one) are folded into 0's @@ -296,61 +303,84 @@ ;; through the higher components if necessary [6]. We now have the next time ;; the command needs to run. ;; -;; The new time is then converted back into a UNIX time, and returned [7]. +;; The new time is then converted back into a UNIX time and returned [7]. (define (parse-vixie-time string) - (let* ((tokens (string-tokenize (vixie-substitute-parse-symbols string))) - (time-spec-list - (map-in-order (lambda (x) (vector (parse-vixie-element - (list-ref tokens (vector-ref x 0)) - (vector-ref x 1) - (vector-ref x 2)) - (vector-ref x 3) - (vector-ref x 4))) - ;; token range-top+1 getter setter + (let ((tokens (string-tokenize (vixie-substitute-parse-symbols string)))) + (cond + ((> (length tokens) 5) + (throw 'mcron-error 9 + "Too many fields in Vixie-style time specification")) + ((< (length tokens) 5) + (throw 'mcron-error 9 + "Not enough fields in Vixie-style time specification"))) + (let ((time-spec-list + (map-in-order (lambda (x) (vector + (let* ((n (vector-ref x 0)) + (tok (list-ref tokens n))) + (cond + ((and (= n 4) + (string=? tok "*") + (not (string=? + (list-ref tokens 2) "*"))) + '()) + ((and (= n 2) + (string=? tok "*") + (not (string=? + (list-ref tokens 4) "*"))) + '()) + (else + (parse-vixie-element + tok + (vector-ref x 1) + (vector-ref x 2))))) ; [0] + (vector-ref x 3) + (vector-ref x 4))) + ;; token range-top+1 getter setter `( #( 0 0 60 ,tm:min ,set-tm:min ) #( 1 0 24 ,tm:hour ,set-tm:hour ) #( 2 1 32 ,tm:mday ,set-tm:mday ) #( 3 0 12 ,tm:mon ,set-tm:mon ) - #( 4 0 7 ,tm:wday ,set-tm:wday ))))) ;; [1] - - (vector-set! (car (last-pair time-spec-list)) - 0 - (map (lambda (time-spec) - (if (eqv? time-spec 7) 0 time-spec)) - (vector-ref (car (last-pair time-spec-list)) 0))) ;; [2] - - (vector-set! (caddr time-spec-list) - 0 - (remove (lambda (day) (eqv? day 0)) - (vector-ref (caddr time-spec-list) 0))) ;; [2.1] - - - (lambda (current-time) ;; [3] - (let ((time (localtime current-time))) ;; [4] - - (if (not (member (tm:mon time) - (time-spec:list (cadddr time-spec-list)))) - (begin - (nudge-month! time (cdddr time-spec-list)) - (set-tm:mday time 0))) - (if (or (eqv? (tm:mday time) 0) - (not (member (tm:mday time) - (interpolate-weekdays - (time-spec:list (caddr time-spec-list)) - (time-spec:list (caddr (cddr time-spec-list))) - (tm:mon time) - (tm:year time))))) - (begin - (nudge-day! time (cddr time-spec-list)) - (set-tm:hour time -1))) - (if (not (member (tm:hour time) - (time-spec:list (cadr time-spec-list)))) - (begin - (nudge-hour! time (cdr time-spec-list)) - (set-tm:min time -1))) ;; [5] - - (set-tm:sec time 0) - (nudge-min! time time-spec-list) ;; [6] - - (car (mktime time)))))) ;; [7] + #( 4 0 7 ,tm:wday ,set-tm:wday ))))) ;; [1] + + (vector-set! (car (last-pair time-spec-list)) + 0 + (map (lambda (time-spec) + (if (eqv? time-spec 7) 0 time-spec)) + (vector-ref (car (last-pair time-spec-list)) 0))) ;; [2] + + (vector-set! (caddr time-spec-list) + 0 + (remove (lambda (day) (eqv? day 0)) + (vector-ref (caddr time-spec-list) 0))) ;; [2.1] + + + (lambda (current-time) ;; [3] + (let ((time (localtime current-time))) ;; [4] + + (if (not (member (tm:mon time) + (time-spec:list (cadddr time-spec-list)))) + (begin + (nudge-month! time (cdddr time-spec-list)) + (set-tm:mday time 0))) + (if (or (eqv? (tm:mday time) 0) + (not (member (tm:mday time) + (interpolate-weekdays + (time-spec:list (caddr time-spec-list)) + (time-spec:list (caddr (cddr time-spec-list))) + (tm:mon time) + (tm:year time))))) + (begin + (nudge-day! time (cddr time-spec-list)) + (set-tm:hour time -1))) + (if (not (member (tm:hour time) + (time-spec:list (cadr time-spec-list)))) + (begin + (nudge-hour! time (cdr time-spec-list)) + (set-tm:min time -1))) ;; [5] + + (set-tm:sec time 0) + (nudge-min! time time-spec-list) ;; [6] + (car (mktime time))))))) ;; [7] + + |