Juggled build infrastructure to make mcron.1 man page properly.

9 files changed, 2197 insertions, 0 deletions

diff --git a/scm/mcron/config.scm.in b/scm/mcron/config.scm.in
new file mode 100644
index 0000000..6a0a85d
--- /dev/null
+++ b/scm/mcron/config.scm.in
@@ -0,0 +1,35 @@
+;; -*-scheme-*-
+
+;;   Copyright (C) 2003 Dale Mellor
+;; 
+;;   This file is part of GNU mcron.
+;;
+;;   GNU mcron is free software: you can redistribute it and/or modify it under
+;;   the terms of the GNU General Public License as published by the Free
+;;   Software Foundation, either version 3 of the License, or (at your option)
+;;   any later version.
+;;
+;;   GNU mcron is distributed in the hope that it will be useful, but WITHOUT
+;;   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;;   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+;;   more details.
+;;
+;;   You should have received a copy of the GNU General Public License along
+;;   with GNU mcron.  If not, see <http://www.gnu.org/licenses/>.
+
+
+;; Some constants set by the configuration process.
+
+(define-module (mcron config))
+
+(define-public config-debug @CONFIG_DEBUG@)
+(define-public config-package-string "@PACKAGE_STRING@")
+(define-public config-package-bugreport "@PACKAGE_BUGREPORT@")
+(define-public config-sendmail "@SENDMAIL@")
+
+(define-public config-spool-dir "@CONFIG_SPOOL_DIR@")
+(define-public config-socket-file "@CONFIG_SOCKET_FILE@")
+(define-public config-allow-file "@CONFIG_ALLOW_FILE@")
+(define-public config-deny-file "@CONFIG_DENY_FILE@")
+(define-public config-pid-file "@CONFIG_PID_FILE@")
+(define-public config-tmp-dir "@CONFIG_TMP_DIR@")
diff --git a/scm/mcron/crontab.scm b/scm/mcron/crontab.scm
new file mode 100644
index 0000000..30e5592
--- /dev/null
+++ b/scm/mcron/crontab.scm
@@ -0,0 +1,228 @@
+;;   Copyright (C) 2003, 2014 Dale Mellor
+;; 
+;;   This file is part of GNU mcron.
+;;
+;;   GNU mcron is free software: you can redistribute it and/or modify it under
+;;   the terms of the GNU General Public License as published by the Free
+;;   Software Foundation, either version 3 of the License, or (at your option)
+;;   any later version.
+;;
+;;   GNU mcron is distributed in the hope that it will be useful, but WITHOUT
+;;   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;;   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+;;   more details.
+;;
+;;   You should have received a copy of the GNU General Public License along
+;;   with GNU mcron.  If not, see <http://www.gnu.org/licenses/>.
+
+
+;; Apart from the collecting of options and the handling of --help and --version
+;; (which are done in the main.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 written to the /var/cron/socket UNIX socket.
+
+(let ((hit-server
+       (lambda (user-name)
+         (catch #t (lambda ()
+                     (let ((socket (socket AF_UNIX SOCK_STREAM 0)))
+                       (connect socket AF_UNIX config-socket-file)
+                       (display user-name socket)
+                       (close socket)))
+                (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.
+
+      (in-access-file?
+       (lambda (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.
+
+      (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? config-allow-file crontab-real-user) #f)
+          (eq? (in-access-file? config-deny-file crontab-real-user) #t))
+      (mcron-error 6 "Access denied by system operator."))
+  
+
+
+  ;; Check that no more than one of the mutually exclusive options are being
+  ;; used.
+
+  (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)
+      (mcron-error 7 "Only one of options -e, -l or -r can be used."))
+
+
+
+  ;; Check that a non-root user is trying to read someone else's files.
+
+  (if (and (not (eqv? (getuid) 0))
+           (option-ref options 'user #f))
+      (mcron-error 8 "Only root can use the -u option."))
+
+
+
+  (let (
+
+  
+        ;; Iff the --user option is given, the crontab-user may be different
+        ;; from the real user.
+
+        (crontab-user (option-ref options 'user crontab-real-user))
+
+
+        ;; So now we know which crontab file we will be manipulating.
+        
+        (crontab-file (string-append config-spool-dir "/" crontab-user))
+
+
+
+        ;; Display the prompt and wait for user to type his choice. Return #t if
+        ;; the answer begins with 'y' or 'Y', return #f if it begins with 'n' or
+        ;; 'N', otherwise ask again.
+
+        (get-yes-no (lambda (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).
+
+    (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. 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
+                                  "/crontab."
+                                  (number->string (getpid)))))
+    (catch #t (lambda () (copy-file crontab-file temp-file))
+              (lambda (key . args) (with-output-to-file temp-file noop)))
+    (chown temp-file (getuid) (getgid))
+    (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)))
+
+
+ ;; 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))
+            noop))
+
+
+ ;; !!!!  This comment is wrong.
+ 
+ ;; 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 '() '()))))
+    (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
+  (mcron-error 15 "usage error: file name must be specified for replace.")))
+
+
+)) ;; End of file-level let-scopes.
diff --git a/scm/mcron/environment.scm b/scm/mcron/environment.scm
new file mode 100644
index 0000000..9f694f1
--- /dev/null
+++ b/scm/mcron/environment.scm
@@ -0,0 +1,105 @@
+;;   Copyright (C) 2003 Dale Mellor
+;; 
+;;   This file is part of GNU mcron.
+;;
+;;   GNU mcron is free software: you can redistribute it and/or modify it under
+;;   the terms of the GNU General Public License as published by the Free
+;;   Software Foundation, either version 3 of the License, or (at your option)
+;;   any later version.
+;;
+;;   GNU mcron is distributed in the hope that it will be useful, but WITHOUT
+;;   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;;   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+;;   more details.
+;;
+;;   You should have received a copy of the GNU General Public License along
+;;   with GNU mcron.  If not, see <http://www.gnu.org/licenses/>.
+
+
+
+;; This file defines the variable current-environment-mods, and the procedures
+;; append-environment-mods (which is available to user configuration files),
+;; clear-environment-mods and modify-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.
+
+
+
+
+(define-module (mcron environment)
+  #:export (modify-environment
+            clear-environment-mods
+            append-environment-mods
+            get-current-environment-mods-copy))
+            
+            
+
+
+;; 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 two variables which the user is not
+;; allowed to control are added at the end of the list.
+
+(define (impose-default-environment env-alist passwd-entry)
+  (append `(("HOME"    . ,(passwd:dir passwd-entry))
+            ("CWD"     . ,(passwd:dir passwd-entry))
+            ("SHELL"   . ,(passwd:shell passwd-entry))
+            ("TERM"    . #f)
+            ("TERMCAP" . #f))
+          env-alist
+          `(("LOGNAME" . ,(passwd:name passwd-entry))
+            ("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 '())
+
+
+
+;; Each time a job is added to the system, we take a snapshot of the current
+;; set of environment modifiers.
+
+(define (get-current-environment-mods-copy)
+  (list-copy 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 in the vixie-specification module
+;; (yuk).
+
+(define (append-environment-mods name value)
+  (set! current-environment-mods (append current-environment-mods
+                                         (list (cons name value))))
+  #t)
diff --git a/scm/mcron/job-specifier.scm b/scm/mcron/job-specifier.scm
new file mode 100644
index 0000000..cce948c
--- /dev/null
+++ b/scm/mcron/job-specifier.scm
@@ -0,0 +1,272 @@
+;;   Copyright (C) 2003 Dale Mellor
+;; 
+;;   This file is part of GNU mcron.
+;;
+;;   GNU mcron is free software: you can redistribute it and/or modify it under
+;;   the terms of the GNU General Public License as published by the Free
+;;   Software Foundation, either version 3 of the License, or (at your option)
+;;   any later version.
+;;
+;;   GNU mcron is distributed in the hope that it will be useful, but WITHOUT
+;;   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;;   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+;;   more details.
+;;
+;;   You should have received a copy of the GNU General Public License along
+;;   with GNU mcron.  If not, see <http://www.gnu.org/licenses/>.
+
+
+
+;; This module defines all the functions that can be used by scheme mcron
+;; configuration files, namely the procedures for working out next times, the
+;; job procedure for registering new jobs (actually a wrapper around the core
+;; add-job function), and the procedure for declaring environment modifications.
+
+(define-module (mcron job-specifier)
+  #:export (range
+            next-year-from         next-year
+            next-month-from        next-month
+            next-day-from          next-day
+            next-hour-from         next-hour
+            next-minute-from       next-minute
+            next-second-from       next-second
+            set-configuration-user
+            set-configuration-time
+            job
+            find-best-next)
+  #:use-module (mcron core)
+  #:use-module (mcron environment)
+  #:use-module (mcron vixie-time)
+  #:re-export (append-environment-mods))
+
+
+
+;; 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;
+;; it is exported from the module for the convenience of other parts of the
+;; mcron implementation) 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 0)
+
+
+
+;; 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 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)))
+(define configuration-time (current-time))
+
+(define (set-configuration-user user)
+  (set! configuration-user (if (or (string? user)
+                                   (integer? user))
+                               (getpw user)
+                               user)))
+(define (set-configuration-time time) (set! configuration-time time))
+
+
+
+;; 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).
+
+(define (job time-proc action . displayable)
+  (let ((action (cond ((procedure? action) action)
+                      ((list? action) (lambda () (primitive-eval action)))
+                      ((string? action) (lambda () (system action)))
+                      (else 
+           (throw 'mcron-error 
+                  2
+                  "job: invalid second argument (action; should be lambda"
+                  " function, string or list)"))))
+
+        (time-proc
+         (cond ((procedure? time-proc) time-proc)
+               ((string? time-proc)    (parse-vixie-time time-proc))
+               ((list? time-proc)      (lambda (current-time)
+                                         (primitive-eval time-proc)))
+               (else
+          (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")
+               ((string? action) action)
+               ((list? action) (with-output-to-string
+                                 (lambda () (display action)))))))
+    (add-job (lambda (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
+             configuration-user)))
diff --git a/scm/mcron/main.scm b/scm/mcron/main.scm
new file mode 100644
index 0000000..36adef9
--- /dev/null
+++ b/scm/mcron/main.scm
@@ -0,0 +1,503 @@
+;;   Copyright (C) 2003, 2012 Dale Mellor
+;; 
+;;   This file is part of GNU mcron.
+;;
+;;   GNU mcron is free software: you can redistribute it and/or modify it under
+;;   the terms of the GNU General Public License as published by the Free
+;;   Software Foundation, either version 3 of the License, or (at your option)
+;;   any later version.
+;;
+;;   GNU mcron is distributed in the hope that it will be useful, but WITHOUT
+;;   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;;   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+;;   more details.
+;;
+;;   You should have received a copy of the GNU General Public License along
+;;   with GNU mcron.  If not, see <http://www.gnu.org/licenses/>.
+
+
+
+;; 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.
+;;
+;; (l0ad "crontab.scm") (sic) is inlined by the makefile. All other
+;; functionality comes through modules in .../share/guile/site/mcron/*.scm.
+
+
+
+;; Pull in some constants set by the builder (via autoconf) at configuration
+;; time. Turn debugging on if indicated.
+
+(use-modules (mcron config))
+(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) (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.
+
+(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
+                            (mcron-error 12 "The command name is invalid."))))
+
+
+
+;; 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
+  (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 #t)
+                                       (predicate
+                                        ,(lambda (value)
+                                           (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))))))
+   (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.
+
+(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, 2006, 2014  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 ~/.config/cron (or the \n
+deprecated ~/.cron) with .guile or .vixie extensions.\n
+\n
+  -v, --version             Display version\n
+  -h, --help                Display this help message\n
+  -sN, --schedule[=]N       Display the next N jobs that will be run by mcron\n
+  -d, --daemon              Immediately detach the program from the terminal\n
+                              and run as a daemon process\n
+  -i, --stdin=(guile|vixie) Format of data passed as standard input or\n
+                              file arguments (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
+  -sN, --schedule[=]N       Display the next N jobs that will be run by cron\n
+  -n, --noetc               Do not check /etc/crontab for updates (HIGHLY\n
+                              RECOMMENDED).")
+  
+  ((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"))
+
+  (else "rubbish"))
+
+"\n\n
+Report bugs to " config-package-bugreport ".\n
+"))
+      (quit)))
+
+
+
+;; 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
+;; invocations of cron don't get the wrong idea that a daemon is currently
+;; running.
+
+(define (delete-run-file)
+  (catch #t (lambda () (delete-file config-pid-file)
+                       (delete-file config-socket-file))
+            noop)
+  (quit))
+
+
+
+;; 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 signal responses to vector to the procedure 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))
+          (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)
+          (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)
+      (c-set-cron-signals)))
+
+
+
+;; Define the functions available to the configuration files. While we're here,
+;; we'll get the core loaded as well.
+
+(use-modules (mcron core)
+             (mcron job-specifier)
+             (mcron vixie-specification))
+
+
+
+;; 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)))
+
+
+
+;; 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).
+
+(define guile-file-regexp (make-regexp "\\.gui(le)?$"))
+(define vixie-file-regexp (make-regexp "\\.vix(ie)?$"))
+
+(define (process-user-file file-path . assume-guile)
+  (cond ((string=? file-path "-")
+               (if (string=? (option-ref options 'stdin "guile") "vixie")
+                   (read-vixie-port (current-input-port))
+                   (eval-string (stdin->string))))
+        ((or (not (null? assume-guile))
+             (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 and/or
+;; $XDG_CONFIG_HOME/cron or ~/.config/cron directories (only happens under the
+;; mcron personality).
+
+(define (process-files-in-user-directory)
+  (let ((errors 0)
+        (home-directory (passwd:dir (getpw (getuid)))))
+    (map (lambda (config-directory)
+          (catch #t
+                 (lambda ()
+                   (let ((directory (opendir config-directory)))
+                     (do ((file-name (readdir directory) (readdir directory)))
+                         ((eof-object? file-name) (closedir directory))
+                       (process-user-file (string-append config-directory
+                                                         "/"
+                                                         file-name)))))
+                 (lambda (key . args)
+                   (set! errors (1+ errors)))))
+          (list (string-append home-directory "/.cron")
+                (string-append (or (getenv "XDG_CONFIG_HOME")
+                                   (string-append home-directory "/.config"))
+                               "/cron")))
+    (if (eq? 2 errors)
+        (mcron-error 13
+                     "Cannot read files in your ~/.config/cron (or ~/.cron) "
+                     "directory."))))
+
+
+
+;; Procedure to check that a user name is in 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))  ;; 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)         ;; / ?? !!!!
+                         (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."))))
+
+
+
+;; 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 .config/cron
+;; (or .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 #t))
+                          (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.")))))
+
+
+
+;; 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. Finally, ensure that the
+;; count is some positive integer.
+
+(and-let* ((count (option-ref options 'schedule #f)))
+          (set! count (string->number count))
+          (display (get-schedule (if (<= count 0) 1 count)))
+          (quit))
+    
+
+
+;; 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 config-pid-file
+            (lambda () (display (getpid)) (newline))))))
+
+
+
+;; If we are running as cron or crond, we establish a socket to listen for
+;; updates from a crontab program. This is put into fd-list so that we can
+;; inform the main wait-run-wait execution loop to listen for incoming messages
+;; on this socket.
+
+(define fd-list '())
+
+(if (eq? command-type 'cron)
+    (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))))
+		     
+
+
+
+;; This function is called whenever a message comes in on the above socket. We
+;; read a user name from the socket, dealing with the "/etc/crontab" special
+;; case, remove all the user's jobs from the job list, and then re-read the
+;; user's updated file. In the special case we drop all the system jobs and
+;; re-read the /etc/crontab file.
+
+(define (process-update-request)
+  (let* ((socket (car (accept (car fd-list))))
+         (user-name (read-line socket)))
+    (close socket)
+    (set-configuration-time (current-time))
+    (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.
+
+(catch-mcron-error
+ (while #t
+        (run-job-loop fd-list)
+        (if (not (null? fd-list))
+            (process-update-request))))
diff --git a/scm/mcron/mcron-core.scm b/scm/mcron/mcron-core.scm
new file mode 100644
index 0000000..518bcac
--- /dev/null
+++ b/scm/mcron/mcron-core.scm
@@ -0,0 +1,271 @@
+;;   Copyright (C) 2003 Dale Mellor
+;; 
+;;   This file is part of GNU mcron.
+;;
+;;   GNU mcron is free software: you can redistribute it and/or modify it under
+;;   the terms of the GNU General Public License as published by the Free
+;;   Software Foundation, either version 3 of the License, or (at your option)
+;;   any later version.
+;;
+;;   GNU mcron is distributed in the hope that it will be useful, but WITHOUT
+;;   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;;   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+;;   more details.
+;;
+;;   You should have received a copy of the GNU General Public License along
+;;   with GNU mcron.  If not, see <http://www.gnu.org/licenses/>.
+
+
+
+(define-module (mcron core)
+  #:use-module (mcron environment)
+  #:export     (add-job
+                remove-user-jobs
+                get-schedule
+                run-job-loop
+                   ;; These three are deprecated and not documented.
+                use-system-job-list
+                use-user-job-list
+                clear-system-jobs)
+  #:re-export  (clear-environment-mods
+                append-environment-mods))
+
+
+(use-modules (srfi srfi-1)    ;; For remove.
+             (srfi srfi-2))   ;; For and-let*.
+
+
+
+;; The list of all jobs known to the system. Each element of the list is
+;;
+;;  (vector user next-time-function action environment displayable next-time)
+;;
+;; where action must be 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 element 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).
+;;
+;; The reason we maintain two lists is that jobs in /etc/crontab may be placed
+;; in one, and all other jobs go in the other. This makes it possible to remove
+;; all the jobs in the first list in one go, and separately we can remove all
+;; jobs from the second list which belong to a particular user. This behaviour
+;; is required for full vixie compatibility.
+
+(define system-job-list '())
+(define user-job-list '())
+
+(define configuration-source 'user)
+
+(define (use-system-job-list) (set! configuration-source 'system))
+(define (use-user-job-list) (set! configuration-source 'user))
+
+
+
+;; 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:displayable job)         (vector-ref job 4))
+(define (job:next-time job)           (vector-ref job 5))
+
+
+
+;; Remove jobs from the user-job-list belonging to this user.
+
+(define (remove-user-jobs user)
+  (if (or (string? user)
+          (integer? user))
+      (set! user (getpw user)))
+    (set! user-job-list
+          (remove (lambda (job) (eqv? (passwd:uid user)
+                                      (passwd:uid (job:user job))))
+                  user-job-list)))
+
+
+
+;; Remove all the jobs on the system job list.
+
+(define (clear-system-jobs) (set! system-job-list '()))
+
+
+
+;; Add a new job with the given specifications to the head of the appropriate
+;; jobs list.
+
+(define (add-job time-proc action displayable configuration-time
+                 configuration-user)
+  (let ((entry (vector configuration-user
+                       time-proc
+                       action
+                       (get-current-environment-mods-copy)
+                       displayable
+                       (time-proc configuration-time))))
+    (if (eq? configuration-source 'user)
+      (set! user-job-list (cons entry user-job-list))
+      (set! system-job-list (cons entry system-job-list)))))
+
+
+
+;; 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)
+  (let ((job-list (append system-job-list user-job-list)))
+    
+    (if (null? job-list)
+        
+        '(#f . '())
+        
+        (let ((next-time 2000000000)
+              (next-jobs-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))))))
+           job-list)
+
+          (cons next-time next-jobs-list)))))
+
+
+
+;; Create a string containing a textual list of the next count jobs to run.
+;;
+;; 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.
+;;
+;; Note that this has the effect of mutating the job timings. Thus the program
+;; must exit after calling this function; the internal data state will be left
+;; unusable.
+
+(define (get-schedule count)
+  (with-output-to-string
+    (lambda ()
+      (do ((count count (- count 1)))
+          ((eqv? count 0))
+        (and-let* ((next-jobs (find-next-jobs))
+                   (time (car next-jobs))
+                   (date-string (strftime "%c %z\n" (localtime time))))
+          (for-each (lambda (job)
+                      (display date-string)
+                      (display (job:displayable job))
+                      (newline)(newline)
+                      (vector-set! job
+                                   5
+                                   ((job:next-time-function job)
+                                                          (job:next-time job))))
+                    (cdr next-jobs)))))))
+
+
+
+;; 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
+                    (setgid (passwd:gid (job:user job)))
+                    (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))
+                    (vector-set! job
+                                 5
+                                 ((job:next-time-function job)
+                                                            (current-time))))))
+            jobs-list))
+
+
+
+;; 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
+;; completed. Repeat ad infinitum.
+;;
+;; Note that, if we wake ahead of time, it can only mean that a signal has been
+;; sent by a crontab job to tell us to re-read a crontab file. In this case we
+;; break out of the loop here, and let the main procedure deal with the
+;; situation (it will eventually re-call this function, thus maintaining the
+;; loop).
+
+(define (run-job-loop . fd-list)
+
+  (call-with-current-continuation
+   (lambda (break)
+     
+     (let ((fd-list (if (null? fd-list) '() (car fd-list))))
+
+       (let loop ()
+
+         (let* ((next-jobs      (find-next-jobs))
+                (next-time      (car next-jobs))
+                (next-jobs-list (cdr next-jobs))
+                (sleep-time     (if next-time (- next-time (current-time))
+                                    2000000000)))
+
+           (and (> sleep-time 0)
+                (if (not (null?
+                          (catch 'system-error
+                                 (lambda ()
+                                   (car (select fd-list '() '() sleep-time)))
+                                 (lambda (key . args) ;; Exception add by Sergey
+						                              ;; Poznyakoff.
+                                   (if (member (car (last args))
+                                               (list EINTR EAGAIN))
+                                       (begin
+                                         (child-cleanup) '())
+                                       (apply throw key args))))))
+                    (break)))
+
+           (run-jobs next-jobs-list)
+
+           (child-cleanup)
+           
+           (loop)))))))
diff --git a/scm/mcron/redirect.scm b/scm/mcron/redirect.scm
new file mode 100644
index 0000000..312b768
--- /dev/null
+++ b/scm/mcron/redirect.scm
@@ -0,0 +1,189 @@
+;;   Copyright (C) 2003 Dale Mellor
+;; 
+;;   This file is part of GNU mcron.
+;;
+;;   GNU mcron is free software: you can redistribute it and/or modify it under
+;;   the terms of the GNU General Public License as published by the Free
+;;   Software Foundation, either version 3 of the License, or (at your option)
+;;   any later version.
+;;
+;;   GNU mcron is distributed in the hope that it will be useful, but WITHOUT
+;;   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;;   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+;;   more details.
+;;
+;;   You should have received a copy of the GNU General Public License along
+;;   with GNU mcron.  If not, see <http://www.gnu.org/licenses/>.
+
+
+
+;; This module 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.
+
+(define-module (mcron redirect)
+  #:export (with-mail-out)
+  #:use-module ((mcron config) :select (config-sendmail))
+  #:use-module (mcron vixie-time))
+
+
+
+;; 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)))
diff --git a/scm/mcron/vixie-specification.scm b/scm/mcron/vixie-specification.scm
new file mode 100644
index 0000000..ab002ba
--- /dev/null
+++ b/scm/mcron/vixie-specification.scm
@@ -0,0 +1,209 @@
+;;   Copyright (C) 2003 Dale Mellor
+;; 
+;;   This file is part of GNU mcron.
+;;
+;;   GNU mcron is free software: you can redistribute it and/or modify it under
+;;   the terms of the GNU General Public License as published by the Free
+;;   Software Foundation, either version 3 of the License, or (at your option)
+;;   any later version.
+;;
+;;   GNU mcron is distributed in the hope that it will be useful, but WITHOUT
+;;   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;;   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+;;   more details.
+;;
+;;   You should have received a copy of the GNU General Public License along
+;;   with GNU mcron.  If not, see <http://www.gnu.org/licenses/>.
+
+
+
+;; 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.
+
+(define-module (mcron vixie-specification)
+  #:export (parse-user-vixie-line
+            parse-system-vixie-line
+            read-vixie-port
+            read-vixie-file
+            check-system-crontab)
+  #:use-module ((mcron config) :select (config-socket-file))
+  #:use-module (mcron core)
+  #:use-module (mcron job-specifier)
+  #:use-module (mcron redirect)
+  #:use-module (mcron vixie-time))
+
+
+(use-modules (ice-9 regex) (ice-9 rdelim)
+             (srfi srfi-1) (srfi srfi-2) (srfi srfi-13) (srfi srfi-14))
+
+
+
+;; 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) 
+        (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))))
+
+
+
+;; 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-system-vixie-line-regexp line)))
+    (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)
+           (lambda () (with-mail-out (match:substring match 4)
+                                     user))
+           (match:substring match 4)))))
+
+
+
+;; 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]*$"))
+
+
+(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)))))
+
+
+
+
+;; 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 the mcron environment module,
+;; 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))
+             (line-number 1 (1+ line-number)))
+            ((eof-object? 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)))))))))
+
+
+
+;; 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
+        (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
+;; modified, and, if so, signals the main routine to re-read the file. We run
+;; under the with-mail-to command so that the process runs as a child,
+;; preventing lockup. If cron is supposed to check for updates to /etc/crontab,
+;; then this procedure will be called about 5 seconds before every minute.
+
+(define (check-system-crontab)
+  (with-mail-out (lambda ()
+                  (let ((mtime (stat:mtime (stat "/etc/crontab"))))
+                    (if (> mtime (- (current-time) 60))
+                        (let ((socket (socket AF_UNIX SOCK_STREAM 0)))
+                          (connect socket AF_UNIX config-socket-file)
+                          (display "/etc/crontab" socket)
+                          (close socket)))))))
diff --git a/scm/mcron/vixie-time.scm b/scm/mcron/vixie-time.scm
new file mode 100644
index 0000000..2f26a6d
--- /dev/null
+++ b/scm/mcron/vixie-time.scm
@@ -0,0 +1,385 @@
+;;   Copyright (C) 2003 Dale Mellor
+;; 
+;;   This file is part of GNU mcron.
+;;
+;;   GNU mcron is free software: you can redistribute it and/or modify it under
+;;   the terms of the GNU General Public License as published by the Free
+;;   Software Foundation, either version 3 of the License, or (at your option)
+;;   any later version.
+;;
+;;   GNU mcron is distributed in the hope that it will be useful, but WITHOUT
+;;   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;;   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+;;   more details.
+;;
+;;   You should have received a copy of the GNU General Public License along
+;;   with GNU mcron.  If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (mcron vixie-time)
+  #:export (parse-vixie-time)
+  #:use-module (mcron job-specifier))
+
+
+(use-modules (srfi srfi-1) (srfi srfi-13) (srfi srfi-14)
+             (ice-9 regex))
+
+
+;; 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)
+               (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)))
+                      (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]. 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
+;; (both values represent sunday) [2]. Any 0's in the month-day component of the
+;; list are removed (this allows a solitary zero to be used to indicate that
+;; jobs should only run on certain days of the _week_) [2.1].
+;;
+;; 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))))
+    (cond
+     ((> (length tokens) 5)
+      (throw 'mcron-error 9
+             "Too many fields in Vixie-style time specification"))
+     ((< (length tokens) 5)
+      (throw 'mcron-error 9
+             "Not enough fields in Vixie-style time specification")))
+    (let ((time-spec-list
+           (map-in-order (lambda (x) (vector
+                                      (let* ((n (vector-ref x 0))
+                                             (tok (list-ref tokens n)))
+                                        (cond
+                                         ((and (= n 4)
+                                               (string=? tok "*")
+                                               (not (string=?
+                                                     (list-ref tokens 2) "*")))
+                                          '())
+                                         ((and (= n 2)
+                                               (string=? tok "*")
+                                               (not (string=?
+                                                     (list-ref tokens 4) "*")))
+                                          '())
+                                         (else
+                                          (parse-vixie-element
+                                           tok
+                                           (vector-ref x 1)
+                                           (vector-ref x 2)))))  ; [0]
+                                      (vector-ref x 3)
+                                      (vector-ref x 4)))
+                 ;; token range-top+1   getter    setter
+                 `( #( 0     0     60      ,tm:min   ,set-tm:min   )
+                    #( 1     0     24      ,tm:hour  ,set-tm:hour  )
+                    #( 2     1     32      ,tm:mday  ,set-tm:mday  )
+                    #( 3     0     12      ,tm:mon   ,set-tm:mon   )
+                    #( 4     0      7      ,tm:wday  ,set-tm:wday  )))))  ;; [1]
+
+      (vector-set! (car (last-pair time-spec-list))
+                   0
+                   (map (lambda (time-spec)
+                          (if (eqv? time-spec 7) 0 time-spec))
+                        (vector-ref (car (last-pair time-spec-list)) 0))) ;; [2]
+
+      (vector-set! (caddr time-spec-list)
+                   0
+                   (remove (lambda (day) (eqv? day 0))
+                           (vector-ref (caddr time-spec-list) 0)))  ;; [2.1]
+
+
+      (lambda (current-time)     ;; [3]
+        (let ((time (localtime current-time)))  ;; [4]
+
+          (if (not (member (tm:mon time)
+                           (time-spec:list (cadddr time-spec-list))))
+              (begin
+                (nudge-month! time (cdddr time-spec-list))
+                (set-tm:mday  time 0)))
+          (if (or (eqv? (tm:mday time) 0)
+                  (not (member (tm:mday time)
+                               (interpolate-weekdays
+                                (time-spec:list (caddr time-spec-list))
+                                (time-spec:list (caddr (cddr time-spec-list)))
+                                (tm:mon time)
+                                (tm:year time)))))
+              (begin
+                (nudge-day! time (cddr time-spec-list))
+                (set-tm:hour time -1)))
+          (if (not (member (tm:hour time)
+                           (time-spec:list (cadr time-spec-list))))
+              (begin
+                (nudge-hour! time (cdr time-spec-list))
+                (set-tm:min time -1)))   ;; [5]
+
+          (set-tm:sec time 0)
+          (nudge-min! time time-spec-list)  ;; [6]
+          (car (mktime time))))))) ;; [7]
+
+