diff options
| author | dale_mellor <dale_mellor> | 2003-08-03 15:14:54 +0000 |
|---|---|---|
| committer | dale_mellor <dale_mellor> | 2003-08-03 15:14:54 +0000 |
| commit | eb50865add48ceccfa38bf4165351dd0418df41f (patch) | |
| tree | b6d34a4e806ba0e61ec63f39320c3c636d82b459 | |
| parent | 2c6cfc753d5c4a6116bcf24307371c33f49bcfd1 (diff) | |
| download | mcron-eb50865add48ceccfa38bf4165351dd0418df41f.tar.gz mcron-eb50865add48ceccfa38bf4165351dd0418df41f.tar.bz2 mcron-eb50865add48ceccfa38bf4165351dd0418df41f.zip | |
Broken all functionality out into separate modules.
| -rw-r--r-- | BUGS | 6 | ||||
| -rw-r--r-- | ChangeLog | 14 | ||||
| -rw-r--r-- | README | 14 | ||||
| -rw-r--r-- | TODO | 27 | ||||
| -rw-r--r-- | config.scm.in | 10 | ||||
| -rw-r--r-- | configure.ac | 7 | ||||
| -rw-r--r-- | crontab.scm | 31 | ||||
| -rw-r--r-- | environment.scm | 75 | ||||
| -rw-r--r-- | job-specifier.scm | 262 | ||||
| -rw-r--r-- | main.scm | 419 | ||||
| -rw-r--r-- | makefile.am | 25 | ||||
| -rw-r--r-- | makefile.ed | 10 | ||||
| -rw-r--r-- | mcron-core.scm | 247 | ||||
| -rw-r--r-- | mcron.scm | 825 | ||||
| -rw-r--r-- | mcron.texinfo | 219 | ||||
| -rw-r--r-- | redirect.scm (renamed from email.scm) | 9 | ||||
| -rw-r--r-- | vixie-specification.scm | 191 | ||||
| -rw-r--r-- | vixie-time.scm (renamed from vixie.scm) | 135 |
18 files changed, 1458 insertions, 1068 deletions
@@ -1,4 +1,8 @@ - -*-text-*- +Copyright (C) 2003 Dale Mellor -*-text-*- +See the end for copying conditions. + + +The currently-known bugs are:- * Daylight savings time shifts are not taken into account very well. If things are critical, your best bet is to set your TZ environment variable to @@ -1,3 +1,14 @@ +2003-08-03 Dale Mellor <dale_mellor@users.sourceforge.net> + + * Third cut, fully functional, modular, production quality, still + needs testing... + + * Pulled all functionality into modules, so it can be incorporated + into other programs. + + * Bumped version to 0.99.3. + + 2003-07-20 Dale Mellor <dale_mellor@users.sourceforge.net> * Second cut, now _really_ fully functional (100% Vixie @@ -21,6 +32,9 @@ * First cut, fully functional, production quality code, just needs testing... + * Broken/incomplete Guile prevents vixie compatibility from + working - this has been disabled by default in the configuration. + * Version set at 0.99.1 @@ -1,8 +1,8 @@ -Copyright (C) 2003 Dale Mellor +Copyright (C) 2003 Dale Mellor -*-text-*- See the end for copying conditions. -This is version 0.99.2 of the mcron program (the second 1.0.0 release +This is version 0.99.3 of the mcron program (the third 1.0.0 release candidate), designed and written by Dale Mellor, which replaces and hugely enhances Vixie cron. It is functionally complete, production quality code (did you expect less?), but has not received much testing yet. It has only been built @@ -44,14 +44,16 @@ m.crontab. See the file INSTALL for generic building and installation instructions. After installation, read the info file for full instructions for use (type -`info mcron' at the command line). +`info mcron' at the command line). Notes for end users, sysadmins, and +developers who wish to incorporate mcron into their own programs are included +here. Known bugs are noted in the BUGS file, and features which might be implemented sometime sooner or later are noted in the TODO file. -Please send all other bug reports either via Savannah at +Please send all other bug reports either via Savannah (preferred) at https://savannah.nongnu.org/bugs/?func=addbug&group=mcron -or by electronic mail to: +or else by electronic mail to: dale_mellor@users.sourceforge.net Mcron is free software. See the file COPYING for copying conditions. @@ -59,6 +61,8 @@ Mcron is free software. See the file COPYING for copying conditions. The mcron development home page is at http://www.nongnu.org/mcron. + + _______________________________________________________________________________ Copyright (C) 2003 Dale Mellor @@ -1,4 +1,4 @@ -Copyright (C) 2003 Dale Mellor +Copyright (C) 2003 Dale Mellor -*-text-*- See the end for copying conditions. @@ -9,12 +9,10 @@ Maybe in the near future... * Check POSIX compliance (should be okay if Vixie cron was okay). - * Work out how to give each user his own closure (or environment or module) - for his configuration files so that he can't mess the core or other - users' files up. Then allow scheme code in the system crontabs. - - * Move the code into modules so that it can be incorporated directly into - other programs. + * Work out how to give each user his own closure (or environment or module + or continuation) for his configuration files so that he can't mess the + core or other users' files up. Then allow scheme code in the system + crontabs. @@ -30,24 +28,17 @@ There are no plans to actually do the following any time soon... -Quite likely to happen if version 2.0 ever materializes... - - * Split program into Vixie and mcron separates (should streamline mcron code - by a factor of three; removes need for security audit). +May happen if version 2.0 ever materializes... * UNIX or TCP socket will allow interrogation and control of a running - daemon (should be more reliable, efficient and useful than using the - SIGHUP-/var/cron/update method). - - - -May happen if version 2.0 ever materializes... + daemon (unrelated to, or maybe a major enhancement of, socket used for + communication from crontab process). * Add anacron functionality (run missed jobs if the daemon is stopped, for example if a personal computer does not run 24 hours a day). * TCP socket to allow control via HTTP (web browser interface). Or maybe - just CGI personality. + crontab-like CGI personality. * GTK+/Bononbo/Gnome2 interface. diff --git a/config.scm.in b/config.scm.in index bd62764..6bd71cb 100644 --- a/config.scm.in +++ b/config.scm.in @@ -20,7 +20,9 @@ ;; Some constants set by the configuration process. -(define config-debug @CONFIG_DEBUG@) -(define config-package-string "@PACKAGE_STRING@") -(define config-package-bugreport "@PACKAGE_BUGREPORT@") -(define config-sendmail "@SENDMAIL@") +(define-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@") diff --git a/configure.ac b/configure.ac index bbbc115..9b4c2de 100644 --- a/configure.ac +++ b/configure.ac @@ -2,7 +2,7 @@ # Process this file with autoconf to produce a configure script. AC_PREREQ(2.57) -AC_INIT(mcron, 0.99.2, dale_mellor@users.sourceforge.net) +AC_INIT(mcron, 0.99.3, dale_mellor@users.sourceforge.net) AM_INIT_AUTOMAKE @@ -24,6 +24,7 @@ AC_SUBST(CONFIG_DEBUG) AC_PROG_CC GUILE_PROGS GUILE_FLAGS +GUILE_SITE_DIR # Checks for programs. AC_CHECK_PROGS(ED, ed) @@ -34,6 +35,10 @@ AC_CHECK_PROGS(WHICH, which) if test "x$ac_cv_prog_WHICH" = "x"; then AC_MSG_ERROR(which not found) fi +AC_CHECK_PROGS(CP, cp) +if test "x$ac_cv_prog_CP" = "x"; then + AC_MSG_ERROR(cp not found) +fi # Now find a sendmail or equivalent. diff --git a/crontab.scm b/crontab.scm index 2c5152d..266311a 100644 --- a/crontab.scm +++ b/crontab.scm @@ -17,7 +17,7 @@ ;; Apart from the collecting of options and the handling of --help and --version -;; (which are done in the mcron.scm file), this file provides all the +;; (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. @@ -25,8 +25,7 @@ ;; Procedure to communicate with running cron daemon that a user has modified -;; his crontab. The user name is placed in /var/cron/update, and the process -;; whose PID is held in /var/run/cron.pid is sent a SIGHUP. +;; his crontab. The user name is written to the /var/cron/socket UNIX socket. (define (hit-server user-name) (catch #t (lambda () @@ -74,19 +73,6 @@ -;; Iff the real user is root, he can use the -u option to access files of -;; another user. - -(define crontab-user (option-ref options 'user crontab-real-user)) - - - -;; So now we know which crontab file we will be manipulating. - -(define crontab-file (string-append "/var/cron/tabs/" crontab-user)) - - - ;; Check that no more than one of the mutually exclusive options are being used. (if (> (+ (if (option-ref options 'edit #f) 1 0) @@ -108,6 +94,19 @@ +;; Iff the --user option is given, the crontab-user may be different from the +;; real user. + +(define crontab-user (option-ref options 'user crontab-real-user)) + + + +;; So now we know which crontab file we will be manipulating. + +(define crontab-file (string-append "/var/cron/tabs/" crontab-user)) + + + ;; 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). diff --git a/environment.scm b/environment.scm index f2a8119..b340330 100644 --- a/environment.scm +++ b/environment.scm @@ -17,23 +17,33 @@ -;; This file defines the global variable current-environment-mods, and the -;; procedures append-environment-mods (which is available to user configuration -;; files), clear-environment-mods, modify-environment, and -;; parse-vixie-environment. The idea is that the current-environment-mods is a -;; list of pairs of environment names and values, and represents the cumulated -;; environment settings in a configuration file. When a job definition is seen -;; in a configuration file, the current-environment-mods are copied into the -;; internal job description, and when the job actually runs these environment -;; modifications are applied to the UNIX environment in which the job runs. +;; 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 one variable which the user is not allowed -;; to control is added at the end of the list. +;; (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)) @@ -66,6 +76,13 @@ +;; 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 @@ -76,46 +93,12 @@ - ;; Procedure to add another environment setting to the alist above. This is used ;; both implicitly by the Vixie parser, and can be used directly by users in ;; scheme configuration files. The return value is purely for the convenience of -;; the parse-vixie-environment procedure below. +;; 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) - - - - -;; Procedure to act on an environment variable specification in a Vixie-style -;; configuration file, by adding an entry to the alist above. Returns #t if the -;; operation was successful, #f if the line could not be interpreted as an -;; environment specification. - -(define parse-vixie-environment-regexp1 - (make-regexp - "^[ \t]*([[:alpha:]_][[:alnum:]_]*)[ \t]*=[ \t]*\"(.*)\"[ \t]*$")) -(define parse-vixie-environment-regexp2 - (make-regexp - "^[ \t]*([[:alpha:]_][[:alnum:]_]*)[ \t]*=[ \t]*\'(.*)\'[ \t]*$")) -(define parse-vixie-environment-regexp3 - (make-regexp - "^[ \t]*([[:alpha:]_][[:alnum:]_]*)[ \t]*=[ \t]*(.*[^ \t])[ \t]*$")) -(define parse-vixie-environment-regexp4 - (make-regexp - "^[ \t]*([[:alpha:]_][[:alnum:]_]*)[ \t]*=[ \t]*$")) - -(use-modules (srfi srfi-2)) - -(define (parse-vixie-environment string) - (let ((match (or (regexp-exec parse-vixie-environment-regexp1 string) - (regexp-exec parse-vixie-environment-regexp2 string) - (regexp-exec parse-vixie-environment-regexp3 string)))) - (if match - (append-environment-mods (match:substring match 1) - (match:substring match 2)) - (and-let* ((match (regexp-exec parse-vixie-environment-regexp4 string))) - (append-environment-mods (match:substring match 1) #f))))) diff --git a/job-specifier.scm b/job-specifier.scm new file mode 100644 index 0000000..3bba9b3 --- /dev/null +++ b/job-specifier.scm @@ -0,0 +1,262 @@ +;; 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 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 + (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 (current-time) + (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))))))) + (add-job (lambda (current-time) + (set! current-action-time current-time) + (time-proc current-time)) + action + displayable + configuration-time + configuration-user))) diff --git a/main.scm b/main.scm new file mode 100644 index 0000000..94cb004 --- /dev/null +++ b/main.scm @@ -0,0 +1,419 @@ +;; 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. +;; +;; (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)) + +(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))) + + + +;; 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 +;; 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 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)) + (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. 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))) + + + +;; 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 (getpw (getuid))) + "/.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)) ;; For and-let*. + +(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) + (use-system-job-list) + (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 (if (eq? count #t) + 8 + (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 "/var/run/cron.pid" + (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) + (let ((socket (socket AF_UNIX SOCK_STREAM 0))) + (bind socket AF_UNIX "/var/cron/socket") + (listen socket 5) + (set! fd-list (list socket)))) + + + +;; 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)) + (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 "/var/cron/tabs/" user-name)))))) + + + +;; 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. + +(while #t + (run-job-loop fd-list) + (process-update-request)) diff --git a/makefile.am b/makefile.am index 12a2a2b..e5efea0 100644 --- a/makefile.am +++ b/makefile.am @@ -18,15 +18,17 @@ ## Process this file with automake to produce Makefile.in ED = @ED@ +CP = @CP@ MAINTAINERCLEANFILES = configure makefile makefile.in \ install-sh missing mkinstalldirs texinfo.tex INSTALL \ aclocal.m4 compile depcomp COPYING -CLEANFILES = mcron.c +CLEANFILES = mcron.c core.scm -EXTRA_DIST = makefile.ed config.scm mcron.scm vixie.scm environment.scm \ - email.scm crontab.scm mcron.c.template +EXTRA_DIST = makefile.ed main.scm mcron-core.scm vixie-specification.scm \ + crontab.scm environment.scm job-specifier.scm redirect.scm \ + vixie-time.scm mcron.c.template info_TEXINFOS = mcron.texinfo bin_PROGRAMS = mcron @@ -34,8 +36,19 @@ mcron_SOURCES = mcron.c mcron_LDFLAGS = @GUILE_LDFLAGS@ mcron_CFLAGS = @GUILE_CFLAGS@ -mcron.c : config.scm mcron.scm vixie.scm environment.scm email.scm crontab.scm \ - makefile.ed mcron.c.template +moddir = @GUILE_SITE@/mcron +mod_DATA = core.scm environment.scm job-specifier.scm redirect.scm \ + vixie-time.scm vixie-specification.scm config.scm + + +# If you're wondering, the configure script keeps deleting all files with a name +# like core.*, so we have to keep re-making it (I lost a good day's work because +# of this). + +core.scm : mcron-core.scm + $(CP) mcron-core.scm core.scm + +mcron.c : main.scm crontab.scm makefile.ed mcron.c.template @echo 'Building mcron.c...' @$(ED) < makefile.ed > /dev/null 2>&1 @rm -f mcron.escaped.scm > /dev/null 2>&1 @@ -56,6 +69,8 @@ install-exec-hook: $(INSTALL) --mode='u=rwxs,og=rx' mcron$(EXEEXT) $(fpp)crontab$(EXEEXT) ./mkinstalldirs -m 'u=rwx' /var/cron ./mkinstalldirs -m 'u=rwx,og=rx' /var/run + ./mkinstalldirs -m 'u=rwx,og=rx' @GUILE_SITE@ + ./mkinstalldirs -m 'u=rwx,og=rx' @GUILE_SITE@/mcron uninstall-hook: rm -f $(fpp){cron,crontab}$(EXEEXT) diff --git a/makefile.ed b/makefile.ed index 15fe15d..af1299b 100644 --- a/makefile.ed +++ b/makefile.ed @@ -17,15 +17,7 @@ # # # -e mcron.scm -/\(load "config.scm"\)/d --1r config.scm -/\(load "vixie.scm"\)/d --1r vixie.scm -/\(load "email.scm"\)/d --1r email.scm -/\(load "environment.scm"\)/d --1r environment.scm +e main.scm /\(load "crontab.scm"\)/d -1r crontab.scm %s/\\/\\\\/g diff --git a/mcron-core.scm b/mcron-core.scm new file mode 100644 index 0000000..90e1da9 --- /dev/null +++ b/mcron-core.scm @@ -0,0 +1,247 @@ +;; 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. + + + +(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 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). +;; +;; 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)) +(define (job:advance-time! job) + (vector-set! job 5 ((job:next-time-function job) (job:next-time job)))) + + + +;; 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) + (if (eq? configuration-source 'user) + (set! user-job-list (cons (vector configuration-user + time-proc + action + (get-current-environment-mods-copy) + displayable + (time-proc configuration-time)) + user-job-list)) + (set! system-job-list (cons (vector configuration-user + time-proc + action + (get-current-environment-mods-copy) + displayable + (time-proc configuration-time)) + 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))))) + + + +;; 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. + +(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\n" (localtime time)))) + (for-each (lambda (job) (display date-string) + (display (job:displayable job)) + (newline)(newline) + (job:advance-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 + (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)) + (job:advance-time! job)))) + jobs-list)) + + + +;; 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. + +(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? (car (select fd-list '() '() sleep-time)))) + (break))) + + (run-jobs next-jobs-list) + + (do () ((or (<= number-children 0) + (eqv? (car (waitpid WAIT_ANY WNOHANG)) 0))) + (set! number-children (- number-children 1))) + + (loop))))))) 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)) diff --git a/mcron.texinfo b/mcron.texinfo index 6f7ca24..1eef0e7 100644 --- a/mcron.texinfo +++ b/mcron.texinfo @@ -7,9 +7,6 @@ @syncodeindex fn cp @copying -This file documents the @code{mcron} command for running jobs at -scheduled times. - Copyright (C) 2003 Dale Mellor This is free software. See the source files for the terms of the copyright. @@ -54,7 +51,7 @@ by the Foundation. @page @vskip 0pt plus 1fill -@insertcopying +@c @insertcopying @end titlepage @@ -64,7 +61,10 @@ by the Foundation. @node Top, Introduction, (dir), (dir) @top mcron -@insertcopying +This file documents the @code{mcron} command (Mellor's cron) for +running jobs at scheduled times. + +@c @insertcopying @end ifnottex @menu @@ -72,6 +72,7 @@ by the Foundation. * Simple examples:: How to use mcron 99.9% of the time. * Syntax:: All the possibilities for configuring cron jobs. * Invoking:: What happens when you run the mcron command. +* Guile modules:: Incorporating mcron into another Guile program. * Index:: The complete index. @detailmenu @@ -109,6 +110,14 @@ Detailed invoking * Running crontab:: * Exit codes:: +Guile modules + +* The core module:: The job list and execution loop. +* The redirect module:: Sending output of jobs to a mail box. +* The vixie-time module:: Parsing vixie-style time specifications. +* The job-specifier module:: All commands for scheme configuration files. +* The vixie-specification module:: Commands for reading vixie-style crontabs. + @end detailmenu @end menu @@ -766,7 +775,7 @@ either). @end itemize -@node Invoking, Index, Syntax, Top +@node Invoking, Guile modules, Syntax, Top @chapter Detailed invoking @cindex invoking @cindex personality @@ -1022,6 +1031,8 @@ become immediately effective. @end table + + @node Exit codes, , Running crontab, Invoking @section Exit codes @cindex exit codes @@ -1107,7 +1118,201 @@ Cron has been run by a user other than root. -@node Index, , Invoking, Top +@node Guile modules, Index, Invoking, Top +@chapter Guile modules +Some of the key parts of mcron are implemented as modules so they can +be incorporated into other Guile programs, or even into C-sourced +programs if they are linked against libguile. + +It may be, for example, that a program needs to perform house-keeping +functions at certain times of the day, in which case it can spawn +(either fork or thread) a sub-process which uses a built-in +mcron. Another example may be a program which must sleep until some +non-absolute time specified on the Gregorian calendar (the first day +of next week, for example). Finally, it may be the wish of the user to +provide a program with the functionality of mcron plus a bit extra. + +The core module maintains mcron's internal job lists, and provides the +main wait-run-wait loop that is mcron's main function. It also +introduces the facilities for accumulating a set of environment +modifiers, which take effect when jobs run. + +@menu +* The core module:: The job list and execution loop. +* The redirect module:: Sending output of jobs to a mail box. +* The vixie-time module:: Parsing vixie-style time specifications. +* The job-specifier module:: All commands for scheme configuration files. +* The vixie-specification module:: Commands for reading vixie-style crontabs. +@end menu + +@node The core module, The redirect module, Guile modules, Guile modules +@section The core module +@cindex guile module +@cindex core module +@cindex modules, core + +This module may be used by including @code{(use-modules (mcron core))} +in a program. The main functions are @code{add-job} and +@code{run-job-loop}, which allow a program to create a list of job +specifications to run, and then to initiate the wait-run-wait loop +firing the jobs off at the requisite times. However, before they are +introduced two functions which manipulate the environment that takes +effect when a job runs are defined. + +@cindex environment +The environment is a set of name-value pairs which is built up +incrementally. Each time the @code{add-job} function is called, the +environment modifiers that have been accumulated up to that point are +stored with the new job specification, and when the job actually runs +these name-value pairs are used to modify the run-time environment in +effect. + +@deffn{Scheme procedure} append-environment-mods name value +When a job is run make sure the environment variable @var{name} has +the value @var{value}. +@end deffn + +@deffn{Scheme procedure} clear-environment-mods +This procedure causes all the environment modifiers that have been +specified so far to be forgotten. +@end deffn + +@deffn{Scheme procedure} add-job time-proc action displayable configuration-time configuration-user +This procedure adds a job specification to the list of all jobs to +run. @var{time-proc} should be a procedure taking exactly one argument +which will be a UNIX time. This procedure must compute the next time +that the job should run, and return the result. @var{action} should be +a procedure taking no arguments, and contains the instructions that +actually get executed whenever the job is scheduled to +run. @var{displayable} should be a string, and is only for the use of +humans; it can be anything which identifies or simply gives a clue as +to the purpose or function of this job. @var{configuration-time} is +the time from which the first invokation of this job should be +computed. Finally, @var{configuration-user} should be the passwd entry +for the user under whose personality the job is to run. +@end deffn + +@deffn{Scheme procedure} run-job-loop . fd-list +@cindex file descriptors +@cindex interrupting the mcron loop +This procedure returns only under exceptional circumstances, but +usually loops forever waiting for the next time to arrive when a job +needs to run, running that job, recomputing the next run time, and +then waiting again. However, the wait can be interrupted by data +becoming available for reading on one of the file descriptors in the +fd-list, if supplied. Only in this case will the procedure return to +the calling program, which may then make modifications to the job list +before calling the @code{run-job-loop} procedure again to resume execution of +the mcron core. +@end deffn + +@deffn{Scheme procedure} remove-user-jobs user + +The argument @var{user} should be a string naming a user (his +login name), or an integer UID, or an object representing the user's passwd +entry. All jobs on the current job list that are scheduled to be run +under this personality are removed from the job list. +@end deffn + +@deffn{Scheme procedure} get-schedule count +@cindex schedule of jobs +The argument @var{count} should be an integer value giving the number +of time-points in the future to report that jobs will run as. Note +that this procedure is disruptive; if @code{run-job-loop} is called +after this procedure, the first job to run will be the one after the +last job that was reported in the schedule report. The report itself +is returned to the calling program as a string. +@end deffn + +@node The redirect module, The vixie-time module, The core module, Guile modules +@section The redirect module +@cindex redirect module +@cindex modules, redirect + +This module is introduced to a program with the command +@code{(use-modules (mcron redirect))}. + +This module provides the @code{with-mail-out} function, described +fully in @ref{Guile Syntax}. + +@node The vixie-time module, The job-specifier module, The redirect module, Guile modules +@section The vixie-time module +@cindex vixie-time module +@cindex modules, vixie-time + +This module is introduced to a program by @code{(use-modules (mcron +vixie-time))}. + +This module provides a single method for converting a vixie-style time +specification into a procedure which can be used as the +@code{next-time-function} to the core @code{add-job} procedure, or to +the @code{job-specifier} @code{job} procedure. See @ref{Vixie Syntax} +for full details of the allowed format for the time string. + +@deffn{Scheme procedure} parse-vixie-time time-string +The single argument @var{time-string} should be a string containing a +vixie-style time specification, and the return value is the required +procedure. +@end deffn + + +@node The job-specifier module, The vixie-specification module, The vixie-time module, Guile modules +@section The job-specifier module +@cindex job-specifier module +@cindex modules, job-specifier + +This module is introduced to a program by @code{(use-modules (mcron +job-specifier))}. + +This module provides all the functions available to user's Guile +configuration files, namely @code{range}, @code{next-year-from}, +@code{next-year}, @code{next-month-from}, @code{next-month}, +@code{next-day-from}, @code{next-day}, @code{next-hour-from}, +@code{next-hour}, @code{next-minute-from}, @code{next-minute}, +@code{next-second-from}, @code{next-second}, + and last but not least, @code{job}. See @ref{Guile Syntax} for full + details. + +Once this module is loaded, a scheme configuration file can be used to +put jobs onto the job list simply by @code{load}ing the file. + +@node The vixie-specification module, , The job-specifier module, Guile modules +@section The vixie-specification module +@cindex vixie-specification module +@cindex modules, vixie-specification + +To use this module, put the command @code{(use-modules (mcron +vixie-specification))} into your program. + +This module exports a couple of functions for adding jobs to the +internal job list according to a Vixie-style crontab file. + +@deffn{Scheme procedure} read-vixie-port port . parse-line + +This procedure reads a crontab from the given port, and adds jobs to +the job list accordingly, taking care of environment specifications +and comments which may appear in such a file. + +@var{parse-line} should not normally be used, except that if you are +parsing a (deprecated) @code{/etc/crontab} file with a slightly +modified syntax, you may pass the value @var{parse-system-vixie-line} +as the optional argument. + +@end deffn + +@deffn{Scheme procedure} read-vixie-file name . parse-line + +This procedure attempts to open the named file, and if it fails will +return silently. Otherwise, the behaviour is identical to +@code{read-vixie-port} above. + +@end deffn + +Once this module has been declared in a program, a crontab file can be +used to augment the current job list with a call to +@code{read-vixie-file}. + +@node Index, , Guile modules, Top @unnumbered Index @printindex cp @@ -16,7 +16,8 @@ ;; USA. -;; This file provides the (with-mail-out action . user) procedure. This + +;; 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 @@ -28,6 +29,12 @@ ;; 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 diff --git a/vixie-specification.scm b/vixie-specification.scm new file mode 100644 index 0000000..89c89f4 --- /dev/null +++ b/vixie-specification.scm @@ -0,0 +1,191 @@ +;; Copyright (C) 2003 Dale Mellor +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, +;; USA. + + + +;; This file provides methods for reading a complete Vixie-style configuration +;; file, either from a real file or an already opened port. It also exposes the +;; method for parsing the time-specification part of a Vixie string, so that +;; these can be used to form the next-time-function of a job in a Guile +;; configuration file. + +(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 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) (begin (display "Bad job line in Vixie file.\n") + (primitive-exit 10))) + (job (match:substring match 1) + (lambda () (with-mail-out (match:substring match 3))) + (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) (begin (display "Bad job line in /etc/crontab.\n") + (primitive-exit 11))) + (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))) + ((eof-object? line)) + + ;; 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 + (string-append + (substring line 0 (- (string-length line) 1)) + next-line)))) + + ;; Consider the three cases mentioned in the description. + (or (regexp-exec read-vixie-file-comment-regexp line) + (parse-vixie-environment line) + (parse-vixie-line line)))))) + + + +;; If a file cannot be opened, we must silently ignore it because it may have +;; been removed by crontab. However, if the file is there it must be parseable, +;; otherwise the error must be propagated to the caller. + +(define (read-vixie-file file-path . parse-vixie-line) + (let ((port #f)) + (catch #t (lambda () (set! port (open-input-file file-path))) + (lambda (key . args) (set! port #f))) + (if port + (begin + (if (null? parse-vixie-line) + (read-vixie-port port) + (read-vixie-port port (car parse-vixie-line))) + (close port))))) + + + +;; 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 "/var/cron/socket") + (display "/etc/crontab" socket) + (close socket))))))) diff --git a/vixie.scm b/vixie-time.scm index 662a194..164a8de 100644 --- a/vixie.scm +++ b/vixie-time.scm @@ -17,17 +17,13 @@ -;; 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-time) + #:export (parse-vixie-time) + #:use-module (mcron job-specifier)) - -(use-modules (ice-9 regex) (ice-9 rdelim) - (srfi srfi-1) (srfi srfi-13) (srfi srfi-14)) - +(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 @@ -358,124 +354,3 @@ (nudge-min! time time-spec-list) ;; [6] (car (mktime time)))))) ;; [7] - - - - -;; A line in a Vixie-style crontab file which gives a command specification -;; carries two pieces of information: a time specification consisting of five -;; space-separated items, and a command which is also separated from the time -;; specification by a space. The line is broken into the two components, and the -;; job procedure run to add the two pieces of information to the job list (this -;; will in turn use the above function to turn the time specification into a -;; function for computing future run times of the command). - -(define parse-user-vixie-line-regexp - (make-regexp "^[[:space:]]*(([^[:space:]]+[[:space:]]+){5})(.*)$")) - -(define (parse-user-vixie-line line) - (let ((match (regexp-exec parse-user-vixie-line-regexp line))) - (if (not match) (begin (display "Bad job line in Vixie file.\n") - (primitive-exit 10))) - (job (match:substring match 1) - (lambda () (with-mail-out (match:substring match 3))) - (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) (begin (display "Bad job line in /etc/crontab.\n") - (primitive-exit 11))) - (set! configuration-user (getpw (match:substring match 3))) - (job (match:substring match 1) - (lambda () (with-mail-out (match:substring match 4) - (passwd:name configuration-user))) - (match:substring match 4)))) - - - - -;; The next procedure reads an entire Vixie-style file. For each line in the -;; file there are three possibilities (after continuation lines have been -;; appended): the line is blank or contains only a comment, the line contains an -;; environment modifier which will be handled in environment.scm, or the line -;; contains a command specification in which case we use the procedure above to -;; add an entry to the internal job list. -;; -;; Note that the environment modifications are cleared, so that there is no -;; interference between crontab files (this might lead to unpredictable -;; behaviour because the order in which crontab files are processed, if there is -;; more than one, is generally undefined). - -(define read-vixie-file-comment-regexp - (make-regexp "^[[:space:]]*(#.*)?$")) - - -(define (read-vixie-port port . parse-vixie-line) - (clear-environment-mods) - (if port - (let ((parse-vixie-line - (if (null? parse-vixie-line) parse-user-vixie-line - (car parse-vixie-line)))) - (do ((line (read-line port) (read-line port))) - ((eof-object? line)) - - ;; If the line ends with \, append the next line. - (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 - (string-append - (substring line 0 (- (string-length line) 1)) - next-line)))) - - ;; Consider the three cases mentioned in the description. - (or (regexp-exec read-vixie-file-comment-regexp line) - (parse-vixie-environment line) - (parse-vixie-line line)))))) - - - -;; If a file cannot be opened, we must silently ignore it because it may have -;; been removed by crontab. However, if the file is there it must be parseable, -;; otherwise the error must be propagated to the caller. - -(define (read-vixie-file file-path . parse-vixie-line) - (let ((port #f)) - (catch #t (lambda () (set! port (open-input-file file-path))) - (lambda (key . args) (set! port #f))) - (if port - (begin - (if (null? parse-vixie-line) - (read-vixie-port port) - (read-vixie-port port (car parse-vixie-line))) - (close port))))) - - - -;; 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 "/var/cron/socket") - (display "/etc/crontab" socket) - (close socket))))))) |