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

Initial version. Production quality, fully complete source but contains known bugs (lots!)

Browse source
This commit is contained in:
dale_mellor 2003-07-04 08:09:04 +00:00
commit 3725aedd02
17 changed files with 3391 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

1
AUTHORS Normal file
View file

@ -0,0 +1 @@
Dale Mellor (dale_mellor@users.sourceforge.net)

13
BUGS Normal file
View file

@ -0,0 +1,13 @@
-*-text-*-
* If two users modify their crontabs simultaneously, there will be contention
for /var/cron/update between themselves and with the main daemon.
* 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).
* As often as not the cron daemon crashes (segfaults) when crontab sends it a
SIGHUP.

30
ChangeLog Normal file
View file

@ -0,0 +1,30 @@
2003-06-30 hydro23 <Dale Mellor <dale@dmellor.dabsol.co.uk>>
* mcron.scm: Introduced arbiters to marshall access to updates
structure between main routing and HUP signal action procedure.
* crontab.scm: When an empty /tmp file is produced for editing,
make it owned by the real user (so he can edit it).
* mcron.scm, makefile.am: Check explicitly for root user when
running cron personality. Install with only root execute
permission.
* mcron.scm: Don't create /var/run/cron.pid if the -s option has
been used (this is an undocumented possibility).
* configure.ac, config.scm.in: Added configure option
--enable-debug to determine whether debugging and traceback should
be turned on.
* Version bumped to 0.99.2.
2003-06-28 Dale Mellor <dale_mellor@users.sourceforge.net>
* First cut, fully functional, production quality code, just needs
testing...
* Version set at 0.99.1

24
NEWS Normal file
View file

@ -0,0 +1,24 @@
Historic moments in the life of mcron.
Copyright (C) 1992, 1993, 1995-2002 Free Software Foundation, Inc.
See the end for copying conditions.
Please send bug reports to dale_mellor@users.sourceforge.net.
----------------------------------------------------------------------
Copyright information:
Copyright (C) 2003 Dale Mellor
Permission is granted to anyone to make or distribute verbatim copies
of this document as received, in any medium, provided that the
copyright notice and this permission notice are preserved,
thus giving the recipient permission to redistribute in turn.
Permission is granted to distribute modified versions
of this document, or of portions of it,
under the above conditions, provided also that they
carry prominent notices stating who last changed them.

50
README Normal file
View file

@ -0,0 +1,50 @@
This is version 0.99.1 of the mcron program, designed and written by Dale
Mellor, which replaces and hugely enhances Vixie cron. It is functionally
complete, production quality code (did you expect less?), but has not received
much testing yet and contains known bugs. It has only been built on a GNU/Linux
system, and will most likely fail on others (but you never know...).
----------------------------------------------------------------------
IMPORTANT NOTICES
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.
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 accurately
Vixie compatible (files in /var/cron/tabs*, /var/cron/allow, /var/cron/deny,
/etc/crontab, /var/run/cron.pid) then you will need to clear out all old
crontabs and make new ones afresh.
If your old cron is Vixie, or very similar, mcron should fall right into place
where your old cron was (the binaries cron and crontab will be replaced), and
you should be able to continue to use your existing crontabs without noticing
any changes. Bear in mind that if you use /etc/crontab, then changes to this
file will *not* take immediate effect (this is the 1% incompatibility between
mcron and Vixie cron); you may want to add a comment to this file with a note to
this effect. Alternatively, use the new mcron program, it's better!
If you don't want to clobber your existing cron executables, you can specify the
--program-prefix option to configure with a prefix ending in a non-alphabetic
character, for example "m.", and then run the programs as m.mcron, m.cron and
m.crontab.
----------------------------------------------------------------------
See the file INSTALL for building and installation instructions.
After installation, read the info file for full instructions for use (type
`info mcron' at the command line).
Known bugs are noted in the BUGS file, and features which might be implemented
sometime sooner or later are noted in the TODO file.
Please send all other bug reports by electronic mail to:
dale_mellor@users.sourceforge.net
Mcron is free software. See the file COPYING for copying conditions.

43
TODO Normal file
View file

@ -0,0 +1,43 @@
Maybe in the near future...
* Logging.
* Check POSIX compliance.
There are no plans to actually do the following any time soon...
* Develop at, batch modes of operation.
* Make compatibilities with other crons (BSD, SYSV, Solaris, Dillon's, ...)
* Port to BSD, other operating systems.
* Full security audit for Vixie mode.
* Move internal functions into a namespace such that configuration files
cannot interfere with mcron itself.
Quite likely to happen if version 2.0 ever materializes...
* Split program into Vixie and mcron separates (should streamline mcron
code by a factor of three; removes need for security audit).
* UNIX or TCP socket will allow interrogation and control of a running
daemon (should be more reliable, efficient and useful than using the
SIGHUP-/var/cron/update method).
May happen if version 2.0 ever materializes...
* Add anacron functionality (run missed jobs if the daemon is stopped, for
example if a personal computer does not run 24 hours a day).
* TCP socket to allow control via HTTP (web browser interface). Or maybe
just CGI personality.
* GTK+/Bononbo interface.

27
config.scm.in Normal file
View file

@ -0,0 +1,27 @@
;; -*-scheme-*-
;; Copyright (C) 2003 Dale Mellor
;;
;; This program 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 2, or (at your option)
;; any later version.
;;
;; This program 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 this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;; USA.
;; Some constants set by the configuration process.
(define config-debug @CONFIG_DEBUG@)
(define config-package-string "@PACKAGE_STRING@")
(define config-package-bugreport "@PACKAGE_BUGREPORT@")
(define config-sendmail "@SENDMAIL@")
(define config-cat "@CAT@")

82
configure.ac Normal file
View file

@ -0,0 +1,82 @@
# -*- Autoconf -*-
# Process this file with autoconf to produce a configure script.
AC_PREREQ(2.57)
AC_INIT(mcron, 0.99.1, dale_mellor@users.sourceforge.net)
AM_INIT_AUTOMAKE
AC_MSG_CHECKING([whether debugging is requested])
AC_ARG_ENABLE(debug,
AC_HELP_STRING([--enable-debug],
[enable debugging and traceback on error]),
CONFIG_DEBUG=$enableval,
CONFIG_DEBUG=no)
AC_MSG_RESULT($CONFIG_DEBUG)
if test "$CONFIG_DEBUG" = "no"; then
CONFIG_DEBUG="#f"
else
CONFIG_DEBUG="#t"
fi
AC_SUBST(CONFIG_DEBUG)
AC_PROG_CC
GUILE_PROGS
GUILE_FLAGS
# Checks for programs.
# AC_CHECK_PROG(CHMOD, chmod, chmod)
AC_CHECK_PROGS(CHMOD, chmod)
if test "x$ac_cv_prog_CHMOD" = "x"; then
AC_MSG_ERROR(chmod not found)
fi
AC_CHECK_PROGS(ED, ed)
if test "x$ac_cv_prog_ED" = "x"; then
AC_MSG_ERROR(ed not found)
fi
AC_CHECK_PROGS(CAT, cat)
if test "x$ac_cv_prog_CAT" = "x"; then
AC_MSG_ERROR(cat not found)
fi
AC_CHECK_PROGS(WHICH, which)
if test "x$ac_cv_prog_WHICH" = "x"; then
AC_MSG_ERROR(which not found)
fi
# Now find a sendmail or equivalent.
AC_CHECK_PROGS(SENDMAIL, sendmail)
if test "x$ac_cv_prog_SENDMAIL" != "x"; then
AC_MSG_CHECKING(sendmail path and arguments)
ac_cv_prog_SENDMAIL="`$ac_cv_prog_WHICH sendmail` -FCronDaemon -odi -oem "
dnl -or0s"
AC_MSG_RESULT($ac_cv_prog_SENDMAIL)
else
AC_CHECK_PROGS(SENDMAIL, mail)
if test "x$ac_cv_prog_SENDMAIL" != "x"; then
AC_MSG_CHECKING(mail path)
ac_cv_prog_SENDMAIL="`$ac_cv_prog_WHICH sendmail` -d "
AC_MSG_RESULT($ac_cv_prog_SENDMAIL)
else
AC_MSG_RESULT(No mail program found)
fi
fi
SENDMAIL=$ac_cv_prog_SENDMAIL
# Checks for libraries.
# Checks for header files.
# Checks for typedefs, structures, and compiler characteristics.
# Checks for library functions.
real_program_prefix=`echo $program_prefix | sed s/NONE//`
AC_SUBST(real_program_prefix)
AC_CONFIG_FILES(makefile config.scm)
AC_OUTPUT

199
crontab.scm Normal file
View file

@ -0,0 +1,199 @@
;; Copyright (C) 2003 Dale Mellor
;;
;; This program 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 2, or (at your option)
;; any later version.
;;
;; This program 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 this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;; USA.
;; Apart from the collecting of options and the handling of --help and --version
;; (which are done in the mcron.scm file), this file provides all the
;; functionality of the crontab personality. It is designed to be loaded and run
;; once, and then the calling program can exit and the crontab program will have
;; completed its function.
;; Procedure to communicate with running cron daemon that a user has modified
;; his crontab. The user name is placed in /var/cron/update, and the process
;; whose PID is held in /var/run/cron.pid is sent a SIGHUP.
(define (hit-server user-name)
(catch #t (lambda ()
(let ((server-pid (with-input-from-file "/var/run/cron.pid"
(lambda () (string->number (read-line))))))
(catch #t (lambda ()
(with-output-to-file "/var/cron/update" (lambda ()
(display user-name)(newline))))
(lambda (key . args)
(display "Cannot write to /var/cron/update.\n")
(primitive-exit 14)))
(kill server-pid SIGHUP)))
(lambda (key . args)
(display "Warning: a cron daemon is not running.\n"))))
;; Procedure to scan a file containing one user name per line (such as
;; /var/cron/allow and /var/cron/deny), and determine if the given name is in
;; there. The procedure returns #t, #f, or '() if the file does not exist.
(define (in-access-file? file name)
(catch #t (lambda ()
(with-input-from-file file (lambda ()
(let loop ((input (read-line)))
(if (eof-object? input)
#f
(if (string=? input name)
#t
(loop (read-line))))))))
(lambda (key . args) '())))
;; This program should have been installed SUID root. Here we get the passwd
;; entry for the real user who is running this program.
(define crontab-real-user (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? "/var/cron/allow" crontab-real-user) #f)
(eq? (in-access-file? "/var/cron/deny" crontab-real-user) #t))
(begin
(display "Access denied by system operator.\n")
(primitive-exit 6)))
;; Iff the real user is root, he can use the -u option to access files of
;; another user.
(define crontab-user
(option-ref options 'user crontab-real-user))
;; So now we know which crontab file we will be manipulating.
(define crontab-file (string-append "/var/cron/tabs/" crontab-user))
;; Check that no more than one of the mutually exclusive options are being used.
(if (> (+ (if (option-ref options 'edit #f) 1 0)
(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)))
;; Check that a non-root user is trying to read someone else's files.
(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)))
;; 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).
(cond
;; In the list personality, we simply open the crontab and copy it
;; 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 options 'list #f)
(catch #t (lambda ()
(with-input-from-file crontab-file (lambda ()
(do ((input (read-char) (read-char)))
((eof-object? input))
(display input)))))
(lambda (key . args)
(display (string-append "No crontab for "
crontab-user
" exists.\n")))))
;; In the edit personality, we determine the name of a temporary file and an
;; editor command, copy an existing crontab file (if it is there) to the
;; temporary file, making sure the ownership is set so the real user can edit
;; 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.
((option-ref options 'edit #f)
(let ((temp-file (string-append "/tmp/crontab." (number->string (getpid))))
(editor (if (getenv "VISUAL") (getenv "VISUAL")
(if (getenv "EDITOR") (getenv "EDITOR")
"vi"))))
(catch #t
(lambda () (copy-file crontab-file temp-file))
(lambda (key . args) (with-output-to-file temp-file (lambda () #t))))
(chown temp-file (getuid) (getgid))
(system (string-append editor " " temp-file))
(read-vixie-file temp-file)
(copy-file temp-file crontab-file)
(delete-file temp-file)
(hit-server crontab-user)))
;; In the remove personality we simply make an effort to delete the crontab and
;; wake the daemon. No worries if this fails.
((option-ref options 'remove #f)
(catch #t (lambda () (delete-file crontab-file)
(hit-server crontab-user))
(lambda (key . args) #t)))
;; In the case of the replace personality we loop over all the arguments on the
;; command line, and for each one parse the file to make sure it is parseable
;; (but subsequently ignore the configuration), and all being well we copy it
;; to the crontab 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 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))
;; 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)))

182
email.scm Normal file
View file

@ -0,0 +1,182 @@
;; Copyright (C) 2003 Dale Mellor
;;
;; This program 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 2, or (at your option)
;; any later version.
;;
;; This program 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 this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;; USA.
;; This file provides the (with-mail-out action . user) procedure. This
;; procedure runs the action in a child process, allowing the user control over
;; the input and output (including standard error). The input is governed (only
;; in the case of a string action) by the placing of percentage signs in the
;; string; the first delimits the true action from the standard input, and
;; subsequent ones denote newlines to be placed into the input. The output (if
;; there actually is any) is controlled by the MAILTO environment variable. If
;; this is not defined, output is e-mailed to the user passed as argument, if
;; any, or else the owner of the action; if defined but empty then any output is
;; sunk to /dev/null; otherwise output is e-mailed to the address held in the
;; MAILTO variable.
;; An action string consists of a sequence of characters forming a command
;; executable by the shell, possibly followed by an non-escaped percentage
;; sign. The text after the percentage sign is to be fed to the command's
;; standard input, with further unescaped percents being substituted with
;; newlines. The escape character can itself be escaped.
;;
;; This regexp separates the two halves of the string, and indeed determines if
;; the second part is present.
(define action-string-regexp (make-regexp "((\\\\%|[^%])*)%(.*)$"))
;; This regexp identifies an escaped percentage sign.
(define e-percent (make-regexp "\\\\%"))
;; Function to execute some action (this may be a shell command, lamdba function
;; or list of scheme procedures) in a forked process, with the input coming from
;; the string, and output (including the error output) being sent to a pipe
;; opened on a mail transport.
(use-modules (ice-9 popen))
(define (with-mail-out action . user)
;; 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
;; variable, and finally in the LOGNAME environment variable. (The case
;; MAILTO="" is dealt with specially below.)
(let* ((mailto (getenv "MAILTO"))
(user (cond (mailto mailto)
((not (null? user)) (car user))
(else (getenv "LOGNAME"))))
(parent->child (pipe))
(child->parent (pipe))
(child-pid (primitive-fork)))
;; The child process. Close redundant ends of pipes, remap the standard
;; streams, and run the action, taking care to chop off the input part of an
;; action string.
(if (eqv? child-pid 0)
(begin
(close (cdr parent->child))
(close (car child->parent))
(dup2 (port->fdes (car parent->child)) 0)
(close (car parent->child))
(dup2 (port->fdes (cdr child->parent)) 1)
(close (cdr child->parent))
(dup2 1 2)
(cond ((string? action)
(let ((match (regexp-exec action-string-regexp action)))
(system (if match
(let ((action (match:substring match 1)))
(do ((match (regexp-exec e-percent action)
(regexp-exec e-percent action)))
((not match))
(set! action (string-append
(match:prefix match)
"%"
(match:suffix match))))
action)
action))))
((procedure? action) (action))
((list? action) (primitive-eval action)))
(primitive-exit 0)))
;; The parent process. Get rid of redundant pipe ends.
(close (car parent->child))
(close (cdr child->parent))
;; Put stuff to child from after '%' in command line, replacing
;; other %'s with newlines. Ugly or what?
(if (string? action)
(let ((port (cdr parent->child))
(match (regexp-exec action-string-regexp action)))
(if (and match
(match:substring match 3))
(with-input-from-string (match:substring match 3)
(lambda ()
(let loop ()
(let ((next-char (read-char)))
(if (not (eof-object? next-char))
(cond
((char=? next-char #\%)
(newline port)
(loop))
((char=? next-char #\\)
(let ((escape (read-char)))
(if (eof-object? escape)
(display #\\ port)
(if (char=? escape #\%)
(begin
(display #\% port)
(loop))
(begin
(display #\\ port)
(display escape port)
(loop))))))
(else
(display next-char port)
(loop)))))))))))
;; So the child process doesn't hang on to its input expecting more stuff.
(close (cdr parent->child))
;; That's got streaming into the child's input out of the way, now we stream
;; the child's output to a mail sink, but only if there is something there
;; in the first place.
(if (eof-object? (peek-char (car child->parent)))
(read-char (car child->parent))
(begin
(set-current-output-port (if (and (string? mailto)
(string=? mailto ""))
(open-output-file "/dev/null")
(open-output-pipe
(string-append config-sendmail
" "
user))))
(set-current-input-port (car child->parent))
(display "To: ") (display user) (newline)
(display "From: mcron") (newline)
(display (string-append "Subject: " user "@" (gethostname)))
(newline)
(newline)
(do ((next-char (read-char) (read-char)))
((eof-object? next-char))
(display next-char))))
(close (car child->parent))
(waitpid child-pid)))

121
environment.scm Normal file
View file

@ -0,0 +1,121 @@
;; Copyright (C) 2003 Dale Mellor
;;
;; This program 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 2, or (at your option)
;; any later version.
;;
;; This program 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 this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;; USA.
;; This file defines the global variable current-environment-mods, and the
;; procedures append-environment-mods (which is available to user configuration
;; files), clear-environment-mods, modify-environment, and
;; parse-vixie-environment. The idea is that the current-environment-mods is a
;; list of pairs of environment names and values, and represents the cumulated
;; environment settings in a configuration file. When a job definition is seen
;; in a configuration file, the current-environment-mods are copied into the
;; internal job description, and when the job actually runs these environment
;; modifications are applied to the UNIX environment in which the job runs.
;; The env-alist is an association list of variable names and values. Variables
;; later in the list will take precedence over variables before. We return a
;; fixed-up version in which some variables are given specific default values
;; (which the user can override), and one variable which the user is not allowed
;; to control is added at the end of the list.
(define (impose-default-environment env-alist passwd-entry)
(append (list (cons "HOME" (passwd:dir passwd-entry))
(cons "CWD" (passwd:dir passwd-entry))
(cons "SHELL" (passwd:shell passwd-entry))
'("TERM" . #f)
'("TERMCAP" . #f))
env-alist
(list (cons "LOGNAME" (passwd:name passwd-entry))
(cons "USER" (passwd:name passwd-entry)))))
;; Modify the UNIX environment for the current process according to the given
;; association list of variables, with the default variable values imposed.
(define (modify-environment env-alist passwd-entry)
(for-each (lambda (variable)
(setenv (car variable) (cdr variable)))
(impose-default-environment env-alist passwd-entry)))
;; As we parse configuration files, we build up an alist of environment
;; variables here.
(define current-environment-mods '())
;; When we start to parse a new configuration file, we want to start with a
;; fresh environment (actually an umodified version of the pervading mcron
;; environment).
(define (clear-environment-mods)
(set! current-environment-mods '()))
;; Procedure to add another environment setting to the alist above. This is used
;; both implicitly by the Vixie parser, and can be used directly by users in
;; scheme configuration files. The return value is purely for the convenience of
;; the parse-vixie-environment procedure below.
(define (append-environment-mods name value)
(set! current-environment-mods (append current-environment-mods
(list (cons name value))))
#t)
;; Procedure to act on an environment variable specification in a Vixie-style
;; configuration file, by adding an entry to the alist above. Returns #t if the
;; operation was successful, #f if the line could not be interpreted as an
;; environment specification.
(define parse-vixie-environment-regexp1
(make-regexp
"^[ \t]*([[:alpha:]_][[:alnum:]_]*)[ \t]*=[ \t]*\"(.*)\"[ \t]*$"))
(define parse-vixie-environment-regexp2
(make-regexp
"^[ \t]*([[:alpha:]_][[:alnum:]_]*)[ \t]*=[ \t]*\'(.*)\'[ \t]*$"))
(define parse-vixie-environment-regexp3
(make-regexp
"^[ \t]*([[:alpha:]_][[:alnum:]_]*)[ \t]*=[ \t]*(.*[^ \t])[ \t]*$"))
(define parse-vixie-environment-regexp4
(make-regexp
"^[ \t]*([[:alpha:]_][[:alnum:]_]*)[ \t]*=[ \t]*$"))
(use-modules (srfi srfi-2))
(define (parse-vixie-environment string)
(let ((match (or (regexp-exec parse-vixie-environment-regexp1 string)
(regexp-exec parse-vixie-environment-regexp2 string)
(regexp-exec parse-vixie-environment-regexp3 string))))
(if match
(append-environment-mods (match:substring match 1)
(match:substring match 2))
(and-let* ((match (regexp-exec parse-vixie-environment-regexp4 string)))
(append-environment-mods (match:substring match 1) #f)))))

61
makefile.am Normal file
View file

@ -0,0 +1,61 @@
## Makefile for the toplevel directory of mcron.
## Copyright (C) 2003 Dale Mellor
##
## This program 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 2, or (at your option)
## any later version.
##
## This program 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 this program; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
## Process this file with automake to produce Makefile.in
ED = @ED@
MAINTAINERCLEANFILES = configure makefile makefile.in \
install-sh missing mkinstalldirs texinfo.tex INSTALL \
aclocal.m4 compile depcomp COPYING
CLEANFILES = mcron.c
EXTRA_DIST = makefile.ed config.scm mcron.scm vixie.scm environment.scm \
email.scm crontab.scm mcron.c.template
info_TEXINFOS = mcron.texinfo
bin_PROGRAMS = mcron
mcron_SOURCES = mcron.c
mcron_LDFLAGS = @GUILE_LDFLAGS@
mcron_CFLAGS = @GUILE_CFLAGS@
mcron.c : config.scm mcron.scm vixie.scm environment.scm email.scm crontab.scm \
makefile.ed mcron.c.template
@echo 'Building mcron.c...'
@$(ED) < makefile.ed > /dev/null 2>&1
@rm -f mcron.escaped.scm > /dev/null 2>&1
install-exec-local:
@if [ `id -u` -ne 0 ]; then \
echo "*** MUST BE ROOT TO INSTALL MCRON ***"; \
exit 1; \
fi
#full program prefix
fpp = $(DESTDIR)$(bindir)/@real_program_prefix@
install-exec-hook:
@rm -f $(fpp)cron$(EXEEXT) > /dev/null 2>&1
@$(INSTALL) --mode='u=rwx' mcron$(EXEEXT) $(fpp)cron$(EXEEXT)
@rm -f $(fpp)crontab$(EXEEXT) > /dev/null 2>&1
@$(INSTALL) --mode='u=rwxs,og=rx' mcron$(EXEEXT) $(fpp)crontab$(EXEEXT)
./mkinstalldirs -m 'u=rwx' /var/cron
./mkinstalldirs -m 'u=rwx,og=rx' /var/run
uninstall-hook:
@rm -f $(fpp){cron,crontab}$(EXEEXT)

42
makefile.ed Normal file
View file

@ -0,0 +1,42 @@
# Copyright (C) 2003 Dale Mellor
#
# This program 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 2, or (at your option)
# any later version.
#
# This program 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 this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
# USA.
#
#
#
e mcron.scm
/\(load "config.scm"\)/d
-1r config.scm
/\(load "vixie.scm"\)/d
-1r vixie.scm
/\(load "email.scm"\)/d
-1r email.scm
/\(load "environment.scm"\)/d
-1r environment.scm
/\(load "crontab.scm"\)/d
-1r crontab.scm
%s/\\/\\\\/g
%s/"/\\"/g
%s/ *;;.*$/ /g
g/^ *$/d
%s/^/\"/
%s/$/\"/
w mcron.escaped.scm
e mcron.c.template
/GUILE_PROGRAM_GOES_HERE/d
-1r mcron.escaped.scm
w mcron.c
q

124
mcron.c.template Normal file
View file

@ -0,0 +1,124 @@
/*
* Copyright (C) 2003 Dale Mellor
*
* This program 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 2, or (at your option)
* any later version.
*
* This program 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 this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
* USA.
*/
/*
This C code represents the thinnest possible wrapper around the Guile code
which constitutes all the functionality of the mcron program. There are two
plus one reasons why we need to do this, and one very unfortunate
consequence.
Firstly, SUID does not work on an executable script. In the end, it is
the execution of the translator, in our case guile, which determines the
effective user, and it is not wise to make the system guile installation
SUID root!
Secondly, executable scripts show up in ugly ways in listings of the
system process table. Guile in particular, with its multi-line
#! ...\ \n -s ...!#
idiosyncracies shows up in process listings in a way that is difficult
to determine what program is actually running.
A third reason for the C wrapper which might be mentioned is that a
security-conscious system administrator can choose to only install a
binary, thus removing the possibility of a user studying a guile script
and working out ways of hacking it to his own ends, or worse still
finding a way to modify it to his own ends.
Unfortunately, running the guile script from inside a C program means
that the sigaction function does not work. Instead, it is necessary to
perform the signal processing in C.
The guile code itself is substituted for the GU1LE_PROGRAM_GOES_HERE (sic)
token by the makefile, which processes the scheme to make it look like one
big string.
*/
#include <signal.h>
#include <libguile.h>
/* This is a function designed to be installed as a signal handler, for signals
which are supposed to initiate shutdown of this program. It calls the scheme
procedure (see mcron.scm for details) to do all the work, and then exits. */
void react_to_terminal_signal (int sig)
{
scm_eval_string (scm_take0str ("(delete-run-file)") );
exit (1);
}
/* This is a function designed to be installed as a signal handler. It calls the
scheme procedure to do all the work (see mcron.scm for details). */
void react_to_hup_signal (int sig)
{
scm_eval_string (scm_take0str ("(process-hup)") );
}
/* This is a function designed to be callable from scheme, and sets up all the
signal handlers required by the cron personality. */
SCM set_cron_signals ()
{
static struct sigaction sa;
memset (&sa, 0, sizeof (sa));
sa.sa_handler = react_to_terminal_signal;
sigaction (SIGTERM, &sa, 0);
sigaction (SIGINT, &sa, 0);
sigaction (SIGQUIT, &sa, 0);
static struct sigaction hup; hup = sa;
hup.sa_handler = react_to_hup_signal;
sigaction (SIGHUP, &hup, 0);
return SCM_BOOL_T;
}
/* The effective main function (i.e. the one that actually does some work). We
register the function above with the guile system, and then execute the mcron
guile program. */
void inner_main ()
{
scm_c_define_gsubr ("c-set-cron-signals", 0, 0, 0, set_cron_signals);
scm_eval_string (scm_take0str (
GUILE_PROGRAM_GOES_HERE
) );
}
/* The real main function. Does nothing but start up the guile subsystem. */
int main (int argc, char **argv)
{
scm_boot_guile (argc, argv, inner_main, 0);
return 0;
}

846
mcron.scm Normal file
View file

@ -0,0 +1,846 @@
;; Copyright (C) 2003 Dale Mellor
;;
;; This program 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 2, or (at your option)
;; any later version.
;;
;; This program 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 this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;; USA.
;; This is the 'main' routine for the whole system; the top of this file is the
;; global entry point (after the minimal C wrapper, mcron.c.template). To all
;; intents and purposes the program is pure Guile and starts here.
;;
;; This file is built into mcron.c.template by the makefile, which stringifies
;; the whole lot, and escapes quotation marks and escape characters
;; accordingly. Bear this in mind when considering literal multi-line strings.
;;
;; (load ...)'s are inlined by the makefile.
;; Make a note of the time the script started; regardless of how long it takes
;; to initialize things, we will run any job scheduled to run after this exact
;; second.
(define configuration-time (current-time))
;; Pull in some constants set by the builder (via autoconf) at configuration
;; time. Turn debugging on if indicated.
(load "config.scm")
(if config-debug (begin (debug-enable 'debug)
(debug-enable 'backtrace)))
;; To determine the name of the program, scan the first item of the command line
;; 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))
(define command-name (match:substring (regexp-exec (make-regexp "[[:alpha:]]*$")
(car (command-line)))))
;; 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.
(define command-type (cond ((string=? command-name "mcron") 'mcron)
((or (string=? command-name "cron")
(string=? command-name "crond")) 'cron)
((string=? command-name "crontab") 'crontab)
(else
(display "The command name is invalid.\n")
(primitive-exit 12))))
;; There are a different set of options for the crontab personality compared to
;; all the others, with the --help and --version options common to all the
;; personalities.
(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))
(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))))))
;; If the user asked for the version of this program, give it to him and get
;; out.
(if (option-ref options 'version #f)
(begin
(display (string-append "\n
" command-name " (" config-package-string ")\n
Written by Dale Mellor\n
\n
Copyright (C) 2003 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
"))
(quit)))
;; Likewise if the user requested the help text.
(if (option-ref options 'help #f)
(begin
(display (string-append "
Usage: " (car (command-line))
(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
extensions.\n
\n
-v, --version Display version\n
-h, --help Display this help message\n
-s, --schedule[=COUNT] Display the next COUNT jobs (default 8) that\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)")
('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
\n
-v, --version Display version\n
-h, --help Display this help message\n
-s, --schedule[=COUNT] Display the next COUNT jobs (default 8) that\n
will be run by cron")
('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")))
"\n\n
Report bugs to " config-package-bugreport ".\n
"))
(quit)))
;;----------------------------------------------------------------------
;; Perform setup processing specific to cron, crond personalities.
;;----------------------------------------------------------------------
;; This is called from the C front-end whenever a terminal signal is
;; received. We simply 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
;; running.
(define (delete-run-file)
(catch #t (lambda () (delete-file "/var/run/cron.pid"))
(lambda (key . args) #t))
(quit))
;; Every time a SIGHUP is received from a crontab process, we read the
;; /var/cron/update file for a user name (he whose crontab has been modified)
;; and add it to this list (thus it may be regarded as a deferred update list).
(define hup-received-for '())
;; Two arbiters to control access to the above list. When an interrupt is
;; received, the list will only be modified if pending-lock is available. If it
;; is not, then the interrupt routine will lock interrupt-required and return
;; immediately to the system, which should at convenient times check this lock
;; and send a SIGHUP to the process to re-run the interrupt routine (obviously,
;; if the main program locks pending-lock (or leaves locked) and issues an
;; interrupt the interrupt routine will be a no-op).
(define pending-lock (make-arbiter "pending-lock"))
(define interrupt-required (make-arbiter "interrupt-required"))
;; This is called from the C front-end whenever a HUP signal is received. We
;; read the name of the user whose crontab has been modified, add his name to
;; the list of pending requests, and remove the update file as an
;; acknowledgement that we received the signal.
;;
;; ! We should put a warning in a log file if we receive a HUP and the update
;; file is not present.
(define (process-hup)
(if (try-arbiter pending-lock)
(begin
(with-input-from-file "/var/cron/update" (lambda ()
(set! hup-received-for (append hup-received-for (list (read-line))))))
(delete-file "/var/cron/update")
(release-arbiter pending-lock))
(try-arbiter interrupt-required)))
;; Setup the cron process, if appropriate. If there is already a
;; /var/run/cron.pid file, then we must assume a cron daemon is already running
;; and refuse to start another one.
;;
;; Otherwise, clear the MAILTO environment variable so that output from cron
;; jobs is sent to the various users (this may still be overridden in the
;; configuration files), and call the function in the C wrapper to set up
;; terminal and hangup signal responses to vector to the two procedures
;; above. The PID file will be filled in properly later when we have forked our
;; daemon process (but not done if we are only viewing the schedules).
(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)))
(if (access? "/var/run/cron.pid" 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 " /var/run/cron.pid.)\n")
(primitive-exit 1)))
(if (not (option-ref options 'schedule #f))
(with-output-to-file "/var/run/cron.pid"
(lambda () #t)))
(setenv "MAILTO" #f)
(c-set-cron-signals)))
;;----------------------------------------------------------------------
;; Define the functions available to the configuration files.
;;----------------------------------------------------------------------
;; Define the with-mail-out command for configuration files to use (directly or
;; indirectly as is the case when we parse vixie-style files).
(load "email.scm")
;; Function (available to user configuration files) which produces a list of
;; values from start up to (but not including) end. An optional step may be
;; supplied, and (if positive) only every step'th value will go into the
;; list. For example, (range 1 6 2) returns '(1 3 5).
(define (range start end . step)
(let ((step (if (or (null? step)
(<= (car step) 0))
1
(car step))))
(let loop ((start start))
(if (>= start end) '()
(cons start
(loop (+ start step)))))))
;; Internal function (not supposed to be used directly in configuration files)
;; which takes a value and a list of possible next values (all assumed less than
;; 9999). It returns a pair consisting of the smallest element of the list, and
;; the smallest element larger than the current value. If an example of the
;; latter cannot be found, 9999 will be returned.
(define (find-best-next current next-list)
(let ((current-best (cons 9999 9999)))
(for-each (lambda (allowed-time)
(if (< allowed-time (car current-best))
(set-car! current-best allowed-time))
(if (and (> allowed-time current)
(< allowed-time (cdr current-best)))
(set-cdr! current-best allowed-time)))
next-list)
current-best))
;; Internal function to return the time corresponding to some near future
;; hour. If hour-list is not supplied, the time returned corresponds to the
;; start of the next hour of the day.
;;
;; If the hour-list is supplied the time returned corresponds to the first hour
;; of the day in the future which is contained in the list. If all the values in
;; the list are less than the current hour, then the time returned will
;; correspond to the first hour in the list *on the following day*.
;;
;; ... except that the function is actually generalized to deal with seconds,
;; minutes, etc., in an obvious way :-)
;;
;; Note that value-list always comes from an optional argument to a procedure,
;; so is wrapped up as the first element of a list (i.e. it is a list inside a
;; list).
(define (bump-time time value-list component higher-component
set-component! set-higher-component!)
(if (null? value-list)
(set-component! time (+ (component time) 1))
(let ((best-next (find-best-next (component time) (car value-list))))
(if (eqv? 9999 (cdr best-next))
(begin
(set-higher-component! time (+ (higher-component time) 1))
(set-component! time (car best-next)))
(set-component! time (cdr best-next)))))
(car (mktime time)))
;; Set of configuration methods which use the above general function to bump
;; specific components of time to the next legitimate value. In each case, all
;; the components smaller than that of interest are taken to zero, so that for
;; example the time of the next year will be the time at which the next year
;; actually starts.
(define (next-year-from current-time . year-list)
(let ((time (localtime current-time)))
(set-tm:mon time 0)
(set-tm:mday time 1)
(set-tm:hour time 0)
(set-tm:min time 0)
(set-tm:sec time 0)
(bump-time time year-list tm:year tm:year set-tm:year set-tm:year)))
(define (next-month-from current-time . month-list)
(let ((time (localtime current-time)))
(set-tm:mday time 1)
(set-tm:hour time 0)
(set-tm:min time 0)
(set-tm:sec time 0)
(bump-time time month-list tm:mon tm:year set-tm:mon set-tm:year)))
(define (next-day-from current-time . day-list)
(let ((time (localtime current-time)))
(set-tm:hour time 0)
(set-tm:min time 0)
(set-tm:sec time 0)
(bump-time time day-list tm:mday tm:mon set-tm:mday set-tm:mon)))
(define (next-hour-from current-time . hour-list)
(let ((time (localtime current-time)))
(set-tm:min time 0)
(set-tm:sec time 0)
(bump-time time hour-list tm:hour tm:mday set-tm:hour set-tm:mday)))
(define (next-minute-from current-time . minute-list)
(let ((time (localtime current-time)))
(set-tm:sec time 0)
(bump-time time minute-list tm:min tm:hour set-tm:min set-tm:hour)))
(define (next-second-from current-time . second-list)
(let ((time (localtime current-time)))
(bump-time time second-list tm:sec tm:min set-tm:sec set-tm:min)))
;; The current-action-time is the time a job was last run, the time from which
;; the next time to run a job must be computed. (When the program is first run,
;; this time is set to the configuration time so that jobs run from that moment
;; forwards.) Once we have this, we supply versions of the time computation
;; commands above which implicitly assume this value.
(define current-action-time configuration-time)
;; We want to provide functions which take a single optional argument (as well
;; as implicitly the current action time), but unlike usual scheme behaviour if
;; the argument is missing we want to act like it is really missing, and if it
;; is there we want to act like it is a genuine argument, not a list of
;; optionals.
(define (maybe-args function args)
(if (null? args)
(function current-action-time)
(function current-action-time (car args))))
;; These are the convenience functions we were striving to define for the
;; configuration files. They are wrappers for the next-X-from functions above,
;; but implicitly use the current-action-time for the time argument.
(define (next-year . args) (maybe-args next-year-from args))
(define (next-month . args) (maybe-args next-month-from args))
(define (next-day . args) (maybe-args next-day-from args))
(define (next-hour . args) (maybe-args next-hour-from args))
(define (next-minute . args) (maybe-args next-minute-from args))
(define (next-second . args) (maybe-args next-second-from args))
;; The list of all jobs known to the system. Each element of the list is
;;
;; (vector user next-time-function action environment next-time)
;;
;; where action may be a string (indicating a shell command) or a list
;; (indicating scheme code) or a procedure, and the environment is an alist of
;; modifications that need making to the UNIX environment before the action is
;; run. The next-time elements is the only one that is modified during the
;; running of a cron process (i.e. all the others are set once and for all at
;; configuration time).
(define job-list '())
;; Convenience functions for getting and setting the elements of a job object.
(define (job:user job) (vector-ref job 0))
(define (job:next-time-function job) (vector-ref job 1))
(define (job:action job) (vector-ref job 2))
(define (job:environment job) (vector-ref job 3))
(define (job:next-time job) (vector-ref job 4))
(define (job:set-next-time! job time) (vector-set! job 4 time))
;; Introduce the definition of an environment object, and provide methods for
;; its manipulation and application to the environment in which we run a job.
(load "environment.scm")
;; Introduce functions which can be used directly in configuration files or
;; indirectly to parse vixie-style time specification strings and manufacture
;; corresponding next-time functions like the ones above.
(load "vixie.scm")
;; The default user for running jobs is the current one (who invoked this
;; program). There are exceptions: when cron parses /etc/crontab the user is
;; specified on each individual line; when cron parses /var/cron/tabs/* the user
;; is derived from the filename of the crontab. These cases are dealt with by
;; mutating this variable. Note that the variable is only used at configuration
;; time; a UID is stored with each job and it is that which takes effect when
;; the job actually runs.
(define configuration-user (getpw (getuid)))
;; The job function, available to configuration files for adding a job rule to
;; the system.
;;
;; Here we must 'normalize' the next-time-function so that it is always a lambda
;; function which takes one argument (the last time the job ran) and returns a
;; single value (the next time the job should run). If the input value is a
;; string this is parsed as a Vixie-style time specification, and if it is a
;; list then we arrange to eval it (but note that such lists are expected to
;; ignore the function parameter - the last run time is always read from the
;; current-action-time global variable). A similar normalization is applied to
;; the action.
;;
;; Here we also compute the first time that the job is supposed to run, by
;; finding the next legitimate time from the current configuration time (set
;; right at the top of this program).
;;
;; Note that the new job is added at the front of the job-list (this is
;; important so that the entries in the system crontab /etc/crontab finish up at
;; the front of the list when we scan that file).
(define (job time-proc action)
(let ((action (cond ((procedure? action) action)
((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))))
(time-proc
(cond ((procedure? time-proc) time-proc)
((string? time-proc) (parse-vixie-time time-proc))
((list? time-proc) (lambda (dummy)
(primitive-eval time-proc)))
(else
(display "job: invalid first argument (next-time-function; should ")
(display "be function, string or list)")
(primitive-exit 3)))))
(set! job-list (cons (vector configuration-user
time-proc
action
(list-copy current-environment-mods)
(time-proc current-action-time))
job-list))))
;;----------------------------------------------------------------------
;; End of definition of procedures for configuration files.
;;----------------------------------------------------------------------
;; Procedure to slurp the standard input into a string.
(define (stdin->string)
(with-output-to-string (lambda () (do ((in (read-char) (read-char)))
((eof-object? in))
(display in)))))
;; Now we have the procedures in place for dealing with the contents of
;; configuration files, the crontab personality is able to validate such
;; files. If the user requested the crontab personality, we load and run the
;; code here and then get out.
(if (eq? command-type 'crontab)
(begin
(load "crontab.scm")
(quit)))
;;----------------------------------------------------------------------
;; Procedures for effecting the configuration process itself.
;;----------------------------------------------------------------------
;; 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).
(define guile-file-regexp (make-regexp "\\.gui(le)?$"))
(define vixie-file-regexp (make-regexp "\\.vix(ie)?$"))
(define (process-user-file file-path)
(cond ((string=? file-path "-")
(if (string=? (option-ref options 'stdin "guile") "vixie")
(read-vixie-port (current-input-port))
(eval-string (stdin->string))))
((regexp-exec guile-file-regexp file-path)
(load file-path))
((regexp-exec vixie-file-regexp file-path)
(read-vixie-file file-path))))
;; Procedure to run through all the files in a user's ~/.cron directory (only
;; happens under the mcron personality).
(define (process-files-in-user-directory)
(catch #t (lambda ()
(let* ((dir-path (string-append (passwd:dir configuration-user)
"/.cron"))
(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)))))
(lambda (key . args)
(display "Cannot read files in your ~/.cron directory.\n")
(primitive-exit 13))))
;; Procedure to check that a user name is the the passwd database (it may happen
;; that a user is removed after creating a crontab). If the user name is valid,
;; the full passwd entry for that user is returned to the caller.
(define (valid-user user-name)
(setpwent)
(do ((entry (getpw) (getpw)))
((or (not entry)
(string=? (passwd:name entry) user-name))
(endpwent)
entry)))
;; Procedure to process all the files in the crontab directory, making sure that
;; each file is for a legitimate user and setting the configuration-user to that
;; user. In this way, when the job procedure is run on behalf of the
;; configuration files, the jobs are registered with the system with the
;; appropriate user. Note that only the root user should be able to perform this
;; operation, but we leave it to the permissions on the /var/cron/tabs directory
;; to enforce this.
(use-modules (srfi srfi-2))
(define (process-files-in-system-directory)
;;; (catch #t (lambda ()
(let ((directory (opendir "/var/cron/tabs")))
(do ((file-name (readdir directory) (readdir directory)))
((eof-object? file-name) (closedir directory))
(and-let* ((user (valid-user file-name)))
(set! configuration-user user)
(read-vixie-file (string-append "/var/cron/tabs/"
file-name)))))
;;; )
;;; (lambda (key . args)
;;; (display "You do not have permission to access the system crontabs.\n")
;;; (primitive-exit 4)))
)
;; The head of the jobs list will contain the jobs specified in /etc/crontab,
;; and this variable tells us how long that head is.
(define system-jobs 0)
;; Having defined all the necessary procedures for scanning various sets of
;; files, we perform the actual configuration of the program depending on the
;; personality we are running as. If it is mcron, we either scan the files
;; passed on the command line, or else all the ones in the user's .cron
;; directory. If we are running under the cron personality, we read the
;; /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)
(let ((start-length (length job-list)))
(read-vixie-file "/etc/crontab" parse-system-vixie-line)
(set! system-jobs (- (length job-list) start-length)))))
;;----------------------------------------------------------------------
;; End of configuration section.
;;
;; Now the main execution loop.
;;----------------------------------------------------------------------
;; Procedure to locate the jobs in the global job-list with the lowest
;; (soonest) next-times. These are the jobs for which we must schedule the mcron
;; program (under any personality) to next wake up. The return value is a cons
;; cell consisting of the next time (maintained in the next-time variable) and a
;; list of the job entries that are to run at this time (maintained in the
;; next-jobs-list variable).
;;
;; The procedure works by first obtaining the time of the first job on the list,
;; and setting this job in the next-jobs-list. Then for each other entry on the
;; job-list, either the job runs earlier than any other that have been scanned,
;; in which case the next-time and next-jobs-list are re-initialized to
;; accomodate, or the job runs at the same time as the next job, in which case
;; the next-jobs-list is simply augmented with the new job, or else the job runs
;; later than others noted in which case we ignore it for now and continue to
;; recurse the list.
(define (find-next-jobs)
(if (null? job-list)
(if (eq? command-type 'mcron)
(begin (display "Nothing to do.\n")
(primitive-exit 5))
(cons #f '()))
(let ((next-time (job:next-time (car job-list)))
(next-jobs-list (list (car job-list))))
(for-each
(lambda (job)
(let ((this-time (job:next-time job)))
(cond ((< this-time next-time)
(set! next-time this-time)
(set! next-jobs-list (list job)))
((eqv? this-time next-time)
(set! next-jobs-list (cons job next-jobs-list))))))
(cdr job-list))
(cons next-time next-jobs-list))))
;; If the user has requested a schedule of jobs that will run, we provide the
;; information here and then get out.
;;
;; Start by determining the number of time points in the future that output is
;; required for. This may be provided on the command line as a parameter to the
;; --schedule option, or else we assume a default of 8. Having determined this
;; count we enter a loop of displaying the next set of jobs to run, artificially
;; forwarding the time to the next time point (instead of waiting for it to
;; occur as we would do in a normal run of mcron), and recurse around the loop
;; count times.
(and-let* ((count (option-ref options 'schedule #f)))
(set! count (if (eq? count #t)
8
(string->number count)))
(if (<= count 0) (set! count 1))
(do ((count count (- count 1)))
((eqv? count 0))
(let* ((next-jobs (find-next-jobs))
(date-string (strftime "%c\n" (localtime (car next-jobs)))))
(for-each (lambda (job) (display date-string)
(write (job:action job))
(newline)(newline))
(cdr next-jobs))))
(quit))
;; For proper housekeeping, it is necessary to keep a record of the number of
;; child processes we fork off to run the jobs.
(define number-children 0)
;; For every job on the list, fork a process to run it (noting the fact by
;; increasing the number-children counter), and in the new process set up the
;; run-time environment exactly as it should be before running the job proper.
;;
;; In the parent, update the job entry by computing the next time the job needs
;; to run.
(define (run-jobs jobs-list)
(for-each (lambda (job)
(if (eqv? (primitive-fork) 0)
(begin
(setuid (passwd:uid (job:user job)))
(chdir (passwd:dir (job:user job)))
(modify-environment (job:environment job) (job:user job))
((job:action job))
(primitive-exit 0))
(begin
(set! number-children (+ number-children 1))
(set! current-action-time (job:next-time job))
(job:set-next-time! job
((job:next-time-function job)
current-action-time)))))
jobs-list))
;; If we are supposed to run as a daemon process (either a --daemon option has
;; been explicitly used, or we are running as cron or crond), detach from the
;; terminal now. If we are running as cron, we can now write the PID file.
(if (option-ref options 'daemon (eq? command-type 'cron))
(begin
(if (not (eqv? (primitive-fork) 0))
(quit))
(setsid)
(if (eq? command-type 'cron)
(with-output-to-file "/var/run/cron.pid"
(lambda () (display (getpid)) (newline))))))
;; Now the main loop. Take the current time. 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. Repeat ad infinitum.
(use-modules (srfi srfi-1))
(let main-loop ()
(release-arbiter pending-lock)
;; Check for any pending updates to the configuration files (as notified by
;; crontab). If one is seen, remove all work from the job-list that belongs to
;; this user, set up the global variables current-action-time and
;; configuration-user appropriately, and then process the new configuration
;; file for the user.
(do () ((and (if (release-arbiter interrupt-required)
(begin (kill (getpid) SIGHUP) #f)
#t)
(null? hup-received-for)))
(try-arbiter pending-lock)
(let ((user (car hup-received-for)))
(set! hup-received-for (cdr hup-received-for))
(release-arbiter pending-lock)
(set! configuration-user (getpw user))
(let ((uid (passwd:uid configuration-user))
(old-job-list job-list))
(set! current-action-time (current-time))
(set! job-list
(append
(list-head old-job-list system-jobs)
(begin (set! job-list '())
(read-vixie-file (string-append "/var/cron/tabs/" user))
job-list)
(remove (lambda (job) (eqv? (passwd:uid (job:user job)) uid))
(list-tail old-job-list system-jobs)))))))
;; Compute the amount of time that we must sleep until the next job is due to
;; run.
(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))
#f)))
;; If an update signal has just come in, or there are no current jobs and a
;; pause operation has been interrupted (presumably by a SIGHUP), or the
;; sleep operation has been interrupted (presumably by a SIGHUP), then undo
;; the latest time calculations and jump back to the top of the loop where
;; the pending updates will be dealt with.
;;
;; Otherwise, when we wake from our sleep, first try to collect as many
;; child zombies as possible from previous job runs, then run the current
;; set of jobs (on the next-jobs-list).
(if (and (null? hup-received-for)
;; ! If a signal occurs now, we won't see it
;; until the next signal.
(eqv? 0 (cond ((not sleep-time) (pause) 1)
((> sleep-time 0) (sleep sleep-time))
(else 0))))
(run-jobs next-jobs-list)))
(do () ((or (<= number-children 0)
(eqv? (car (waitpid WAIT_ANY WNOHANG)) 0)))
(set! number-children (- number-children 1)))
(main-loop))

1094
mcron.texinfo Normal file
View file

File diff suppressed because it is too large Load diff

452
vixie.scm Normal file
View file

@ -0,0 +1,452 @@
;; Copyright (C) 2003 Dale Mellor
;;
;; This program 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 2, or (at your option)
;; any later version.
;;
;; This program 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 this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;; USA.
;; This file provides methods for reading a complete Vixie-style configuration
;; file, either from a real file or an already opened port. It also exposes the
;; method for parsing the time-specification part of a Vixie string, so that
;; these can be used to form the next-time-function of a job in a Guile
;; configuration file.
(use-modules (ice-9 regex) (ice-9 rdelim) (srfi srfi-13) (srfi srfi-14))
;; In Vixie-style time specifications three-letter symbols are allowed to stand
;; for the numbers corresponding to months and days of the week. We deal with
;; this by making a textual substitution early on in the processing of the
;; strings.
;;
;; We start by defining, once and for all, a list of cons cells consisting of
;; regexps which will match the symbols - which allow an arbitrary number of
;; other letters to appear after them (so that the user can optionally complete
;; the month and day names; this is an extension of Vixie) - and the value which
;; is to replace the symbol.
;;
;; The procedure then takes a string, and then for each symbol in the
;; parse-symbols list attempts to locate an instance and replace it with an
;; ASCII representation of the value it stands for. The procedure returns the
;; modified string. (Note that each symbol can appear only once, which meets the
;; Vixie specifications technically but still allows silly users to mess things
;; up).
(define parse-symbols
(map (lambda (symbol-cell)
(cons (make-regexp (string-append (car symbol-cell) "[[:alpha:]]*")
regexp/icase)
(cdr symbol-cell)))
'(("jan" . "0") ("feb" . "1") ("mar" . "2") ("apr" . "3")
("may" . "4") ("jun" . "5") ("jul" . "6") ("aug" . "7")
("sep" . "8") ("oct" . "9") ("nov" . "10") ("dec" . "11")
("sun" . "0") ("mon" . "1") ("tue" . "2") ("wed" . "3")
("thu" . "4") ("fri" . "5") ("sat" . "6") )))
(define (vixie-substitute-parse-symbols string)
(for-each (lambda (symbol-cell)
(let ((match (regexp-exec (car symbol-cell) string)))
(if match
(set! string (string-append (match:prefix match)
(cdr symbol-cell)
(match:suffix match))))))
parse-symbols)
string)
;; A Vixie time specification is made up of a space-separated list of elements,
;; and the elements consist of a comma-separated list of subelements. The
;; procedure below takes a string holding a subelement, which should have no
;; spaces or symbols (see above) in it, and returns a list of all values which
;; that subelement indicates. There are five distinct cases which must be dealt
;; with: [1] a single '*' which returns a list of all values; [2] a '*' followed
;; by a step specifier; [3] a range and step specifier; [4] a range; and [5] a
;; single number.
;;
;; To perform the computation required for the '*' cases, we need to pass the
;; limit of the allowable range for this subelement as the third argument. As
;; days of the month start at 1 while all the other time components start at 0,
;; we must pass the base of the range to deal with this case also.
(define parse-vixie-subelement-regexp
(make-regexp "^([[:digit:]]+)(-([[:digit:]]+)(/([[:digit:]]+))?)?$"))
(define (parse-vixie-subelement string base limit)
(if (char=? (string-ref string 0) #\*)
(range base limit (if (> (string-length string) 1)
(string->number (substring string 2)) ;; [2]
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))
((match:substring match 5)
(range (string->number (match:substring match 1))
(+ 1 (string->number (match:substring match 3)))
(string->number (match:substring match 5)))) ;; [3]
((match:substring match 3)
(range (string->number (match:substring match 1))
(+ 1 (string->number (match:substring match 3))))) ;; [4]
(else
(list (string->number (match:substring match 1)))))))) ;; [5]
;; A Vixie element contains the entire specification, without spaces or symbols,
;; of the acceptable values for one of the time components (minutes, hours,
;; days, months, week days). Here we break the comma-separated list into
;; subelements, and process each with the procedure above. The return value is a
;; list of all the valid values of all the subcomponents.
;;
;; The second and third arguments are the base and upper limit on the values
;; that can be accepted for this time element.
;;
;; The effect of the 'apply append' is to merge a list of lists into a single
;; list.
(define (parse-vixie-element string base limit)
(apply append
(map (lambda (sub-element)
(parse-vixie-subelement sub-element base limit))
(string-tokenize string (char-set-complement (char-set #\,))))))
;; Consider there are two lists, one of days in the month, the other of days in
;; the week. This procedure returns an augmented list of days in the month with
;; weekdays accounted for.
(define (interpolate-weekdays mday-list wday-list month year)
(let ((t (localtime 0)))
(set-tm:mday t 1)
(set-tm:mon t month)
(set-tm:year t year)
(let ((first-day (tm:wday (cdr (mktime t)))))
(apply append
mday-list
(map (lambda (wday)
(let ((first (- wday first-day)))
(if (< first 0) (set! first (+ first 7)))
(range (+ 1 first) 32 7)))
wday-list)))))
;; Return the number of days in a month. Fix up a tm object for the zero'th day
;; of the next month, rationalize the object and extract the day.
(define (days-in-month month year)
(let ((t (localtime 0))) (set-tm:mday t 0)
(set-tm:mon t (+ month 1))
(set-tm:year t year)
(tm:mday (cdr (mktime t)))))
;; We will be working with a list of time-spec's, one for each element of a time
;; specification (minute, hour, ...). Each time-spec holds three pieces of
;; information: a list of acceptable values for this time component, a procedure
;; to get the component from a tm object, and a procedure to set the component
;; in a tm object.
(define (time-spec:list time-spec) (vector-ref time-spec 0))
(define (time-spec:getter time-spec) (vector-ref time-spec 1))
(define (time-spec:setter time-spec) (vector-ref time-spec 2))
;; This procedure modifies the time tm object by setting the component referred
;; to by the time-spec object to its next acceptable value. If this value is not
;; greater than the original (because we have wrapped around the top of the
;; acceptable values list), then the function returns #t, otherwise it returns
;; #f. Thus, if the return value is true then it will be necessary for the
;; caller to increment the next coarser time component as well.
;;
;; The first part of the let block is a concession to humanity; the procedure is
;; simply unreadable without all of these aliases.
(define (increment-time-component time time-spec)
(let* ((time-list (time-spec:list time-spec))
(getter (time-spec:getter time-spec))
(setter (time-spec:setter time-spec))
(next-best (find-best-next (getter time) time-list))
(wrap-around (eqv? (cdr next-best) 9999)))
(setter time ((if wrap-around car cdr) next-best))
wrap-around))
;; There now follows a set of procedures for adjusting an element of time,
;; i.e. taking it to the next acceptable value. In each case, the head of the
;; time-spec-list is expected to correspond to the component of time in
;; question. If the adjusted value wraps around its allowed range, then the next
;; biggest element of time must be adjusted, and so on.
;; There is no specification allowed for the year component of
;; time. Therefore, if we have to make an adjustment (presumably because a
;; monthly adjustment has wrapped around the top of its range) we can simply
;; go to the next year.
(define (nudge-year! time)
(set-tm:year time (+ (tm:year time) 1)))
;; We nudge the month by finding the next allowable value, and if it wraps
;; around we also nudge the year. The time-spec-list will have time-spec
;; objects for month and weekday.
(define (nudge-month! time time-spec-list)
(and (increment-time-component time (car time-spec-list))
(nudge-year! time)))
;; Try to increment the day component of the time according to the combination
;; of the mday-list and the wday-list. If this wraps around the range, or if
;; this falls outside the current month (31st February, for example), then
;; bump the month, set the day to zero, and recurse on this procedure to find
;; the next day in the new month.
;;
;; The time-spec-list will have time-spec entries for mday, month, and
;; weekday.
(define (nudge-day! time time-spec-list)
(if (or (increment-time-component
time
(vector
(interpolate-weekdays (time-spec:list (car time-spec-list))
(time-spec:list (caddr time-spec-list))
(tm:mon time)
(tm:year time))
tm:mday
set-tm:mday))
(> (tm:mday time) (days-in-month (tm:mon time) (tm:year time))))
(begin
(nudge-month! time (cdr time-spec-list))
(set-tm:mday time 0)
(nudge-day! time time-spec-list))))
;; The hour is bumped to the next accceptable value, and the day is bumped if
;; the hour wraps around.
;;
;; The time-spec-list holds specifications for hour, mday, month and weekday.
(define (nudge-hour! time time-spec-list)
(and (increment-time-component time (car time-spec-list))
(nudge-day! time (cdr time-spec-list))))
;; The minute is bumped to the next accceptable value, and the hour is bumped
;; if the minute wraps around.
;;
;; The time-spec-list holds specifications for minute, hour, day-date, month
;; and weekday.
(define (nudge-min! time time-spec-list)
(and (increment-time-component time (car time-spec-list))
(nudge-hour! time (cdr time-spec-list))))
;; This is a procedure which returns a procedure which computes the next time a
;; command should run after the current time, based on the information in the
;; Vixie-style time specification.
;;
;; 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
;; 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
;; (both values represent sunday) [2].
;;
;; The returned procedure itself:-
;;
;; Starts by obtaining the current broken-down time [4], and fixing it to
;; ensure that it is an acceptable value, as follows. Each component from the
;; biggest down is checked for acceptability, and if it is not acceptable it
;; is bumped to the next acceptable value (this may cause higher components to
;; also be bumped if there is range wrap-around) and all the lower components
;; are set to -1 so that it can successfully be bumped up to zero if this is
;; an allowed value. The -1 value will be bumped up subsequently to an allowed
;; value [5].
;;
;; Once it has been asserted that the current time is acceptable, or has been
;; adjusted to one minute before the next acceptable time, the minute
;; component is then bumped to the next acceptable time, which may ripple
;; 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].
(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
`( #( 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]
(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)
(set-tm:hour time -1)
(set-tm:min time -1)))
(if (not (member (tm:mday time) ;; !!
(time-spec:list (caddr time-spec-list))))
(begin
(nudge-day! time (cddr time-spec-list))
(set-tm:hour time -1)
(set-tm:min 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]
;; A line in a Vixie-style crontab file which gives a command specification
;; carries two pieces of information: a time specification consisting of five
;; space-separated items, and a command which is also separated from the time
;; specification by a space. The line is broken into the two components, and the
;; job procedure run to add the two pieces of information to the job list (this
;; will in turn use the above function to turn the time specification into a
;; function for computing future run times of the command).
(define parse-user-vixie-line-regexp
(make-regexp "^[[:space:]]*(([^[:space:]]+[[:space:]]+){5})(.*)$"))
(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)))
(job (match:substring match 1)
(lambda () (with-mail-out (match:substring match 3))))))
;; The case of reading a line from /etc/crontab is similar to above but the user
;; ID appears in the sixth field, before the action.
(define parse-system-vixie-line-regexp
(make-regexp (string-append "^[[:space:]]*(([^[:space:]]+[[:space:]]+){5})"
"([[:alpha:]][[:alnum:]_]*)[[:space:]]+(.*)$")))
(define (parse-system-vixie-line line)
(let ((match (regexp-exec parse-user-vixie-line-regexp line)))
(if (not match) (begin (display "Bad job line in /etc/crontab.\n")
(primitive-exit 11)))
(set! configuration-user (passwd (match:substring match 3)))
(job (match:substring match 1)
(lambda () (with-mail-out (match:substring match 4)
(passwd:name configuration-user))))))
;; The next procedure reads an entire Vixie-style file. For each line in the
;; file there are three possibilities (after continuation lines have been
;; appended): the line is blank or contains only a comment, the line contains an
;; environment modifier which will be handled in environment.scm, or the line
;; contains a command specification in which case we use the procedure above to
;; add an entry to the internal job list.
;;
;; Note that the environment modifications are cleared, so that there is no
;; interference between crontab files (this might lead to unpredictable
;; behaviour because the order in which crontab files are processed, if there is
;; more than one, is generally undefined).
(define read-vixie-file-comment-regexp
(make-regexp "^[[:space:]]*(#.*)?$"))
(define (read-vixie-port port . parse-vixie-line)
(clear-environment-mods)
(if port
(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)))
((eof-object? line))
;; If the line ends with \, append the next line.
(do ()
((or (< (string-length line) 1)
(not (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))))))
;; If a file cannot be opened, we must silently ignore it because it may have
;; been removed by crontab. However, if the file is there it must be parseable,
;; otherwise the error must be propagated to the caller.
(define (read-vixie-file file-path . parse-vixie-line)
(let ((port #f))
(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)))))