dmbcs/mcron
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Update to 1.0.3. Lots of small changes, mainly to work with guile 1.8.0. Daylight savings time is now handled okay. Bug fix in Vixie parser. User gets option to correct bad crontab entries.

Browse source
This commit is contained in:
dale_mellor 2006-04-16 22:10:43 +00:00
commit 011df9b8fd
13 changed files with 463 additions and 294 deletions
Download patch file Download diff file Expand all files Collapse all files

7
BUGS
View file

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

14
NEWS
View file

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

6
README
View file

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

8
configure.ac
View file

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

73
crontab.scm
View file

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

27
job-specifier.scm
View file

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

258
main.scm
View file

@ -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.
;; Sergey Poznyakoff: we can also drop out of run-job-loop because of a SIGCHLD,
;; so must test fd-list.
(while #t
(run-job-loop fd-list)
(process-update-request))
(catch-mcron-error
(while #t
(run-job-loop fd-list)
(if (not (null? fd-list))
(process-update-request))))

2
makefile.am
View file

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

59
mcron-core.scm
View file

@ -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))))
(call-with-current-continuation
(lambda (break)
(let ((fd-list (if (null? fd-list) '() (car fd-list))))
(let loop ()
(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)))
(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)
(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)))
(do () ((or (<= number-children 0)
(eqv? (car (waitpid WAIT_ANY WNOHANG)) 0)))
(set! number-children (- number-children 1)))
(loop)))))))
(run-jobs next-jobs-list)
(child-cleanup)
(loop)))))))

1
mcron.c.template
View file

@ -53,6 +53,7 @@
#include <string.h>
#include <signal.h>
#include <libguile.h>

95
mcron.texinfo.in
View file

@ -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.
@copying This manual is for GNU mcron (version @VERSION@), which is a
program for running jobs at scheduled times.
@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.
Copyright @copyright{} 2003, 2005, 2006 Dale Mellor
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).
@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.''
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
(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

75
vixie-specification.scm
View file

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

132
vixie-time.scm
View file

@ -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]
#( 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! (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]
(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]
(set-tm:sec time 0)
(nudge-min! time time-spec-list) ;; [6]
(car (mktime time)))))) ;; [7]