Broken all functionality out into separate modules.

1 files changed, 0 insertions, 825 deletions

diff --git a/mcron.scm b/mcron.scm
deleted file mode 100644
index eb8c9a0..0000000
--- a/mcron.scm
+++ /dev/null
@@ -1,825 +0,0 @@
-;;   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))
-                              (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))))))
-
-
-
-
-;; 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\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")))
-
-"\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")
-                       (delete-file "/var/cron/socket"))
-            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 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" noop))
-      (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 displayable 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 system-job-list '())
-(define user-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:displayable job)         (vector-ref job 4))
-(define (job:next-time job)           (vector-ref job 5))
-(define (job:advance-time! job)
-  (set! current-action-time (job:next-time job))
-  (vector-set! job 5 ((job:next-time-function job) current-action-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 configuration-source 'user)
-
-(define (job time-proc action . displayable)
-  (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))))
-        (displayable
-         (cond ((not (null? displayable)) (car displayable))
-               ((procedure? action) "Lambda function")
-               ((string? action) action)
-               ((list? action) (with-output-to-string
-                                 (lambda () (display action)))))))
-    (if (eq? configuration-source 'user)
-        (set! user-job-list (cons (vector configuration-user
-                                          time-proc
-                                          action
-                                          (list-copy current-environment-mods)
-                                          displayable
-                                          (time-proc current-action-time))
-                                  user-job-list))
-        (set! system-job-list (cons (vector configuration-user
-                                            time-proc
-                                            action
-                                            (list-copy current-environment-mods)
-                                            displayable
-                                     (time-proc current-action-time))
-                                    system-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 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))
-
-(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))
-                  (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))))
-
-
-
-;; 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)
-         (set! configuration-source 'system)
-         (read-vixie-file "/etc/crontab" parse-system-vixie-line)
-         (set! configuration-source 'user)))
-
-
-(if (eq? command-type 'cron)
-    (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 (getpw "root"))
-          (job '(- (next-minute-from (next-minute)) 6)
-               check-system-crontab
-               "/etc/crontab update checker."))))
-
-
-
-;;----------------------------------------------------------------------
-;;   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)
-  (let ((job-list (append system-job-list user-job-list)))
-    
-    (if (null? job-list)
-        
-        (if (eq? command-type 'mcron)
-            (begin (display "Nothing to do.\n")
-                   (primitive-exit 5))
-            (cons #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)))))
-
-
-
-;; 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)
-                                      (display (job:displayable job))
-                                      (newline)(newline)
-                                      (job:advance-time! job))
-                        (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:advance-time! job))))
-            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))))))
-
-
-
-(define fd-list '())
-
-
-
-(if (eq? command-type 'cron)
-    (let ((socket (socket AF_UNIX SOCK_STREAM 0)))
-      (bind socket AF_UNIX "/var/cron/socket")
-      (listen socket 5)
-      (set! fd-list (list socket))))
-
-
-
-(define (process-update-request)
-  (let* ((socket (car (accept (car fd-list))))
-         (user-name (read-line socket)))
-    (close socket)
-    (set! configuration-time (current-time))
-    (if (string=? user-name "/etc/crontab")
-        (begin
-          (set! system-job-list '())
-          (set! configuration-source 'system)
-          (read-vixie-file "/etc/crontab" parse-system-vixie-line)
-          (set! configuration-source 'user))
-        (let ((user (getpw user-name)))
-          (set! user-job-list
-                (remove (lambda (job) (eqv? (passwd:uid user)
-                                            (passwd:uid (job:user job))))
-                        user-job-list))
-          (set! configuration-user user)
-          (read-vixie-file (string-append "/var/cron/tabs/" user-name))))))
-
-
-
-;; 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 ()
-
-  ;; 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 (and (or (not sleep-time) (> sleep-time 0))
-             (not (null? (car (select fd-list '() '() sleep-time)))))
-        (process-update-request)
-        (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))