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