;; 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))