SummaryRefsLogTreeCommitDiffStats
path: root/scm/mcron/main.scm
diff options
context:
space:
mode:
authorMathieu Lirzin <mthl@gnu.org>2017-09-27 23:10:29 +0200
committerMathieu Lirzin <mthl@gnu.org>2017-09-27 23:10:29 +0200
commit41b427e1b220389eccd65e436fc3452e2bc0215d (patch)
tree431584749084f7b041d406153cfcf1ad1f043737 /scm/mcron/main.scm
parentc0a6eb14c257a47e9573631e5ac09e6528fba377 (diff)
downloadmcron-41b427e1b220389eccd65e436fc3452e2bc0215d.tar.gz
mcron-41b427e1b220389eccd65e436fc3452e2bc0215d.tar.bz2
mcron-41b427e1b220389eccd65e436fc3452e2bc0215d.zip
Revert "Taken on board suggestions of Mathieu Lirzin as per e-mails to the bug-mcron@gnu.org mailing list around September 2015."
This reverts commit c0a6eb14c257a47e9573631e5ac09e6528fba377.
Diffstat (limited to 'scm/mcron/main.scm')
-rw-r--r--scm/mcron/main.scm673
1 files changed, 362 insertions, 311 deletions
diff --git a/scm/mcron/main.scm b/scm/mcron/main.scm
index dc839cc..36adef9 100644
--- a/scm/mcron/main.scm
+++ b/scm/mcron/main.scm
@@ -1,4 +1,4 @@
-;; Copyright (C) 2003, 2012, 2015 Dale Mellor
+;; Copyright (C) 2003, 2012 Dale Mellor
;;
;; This file is part of GNU mcron.
;;
@@ -16,24 +16,34 @@
;; with GNU mcron. If not, see <http://www.gnu.org/licenses/>.
-(define-module (mcron main)
- #:use-module (ice-9 getopt-long)
- #:use-module (ice-9 rdelim)
- #:use-module (ice-9 regex)
- #:use-module (mcron config)
- #:use-module (mcron mcron-core)
- #:use-module (mcron job-specifier)
- #:use-module (mcron vixie-specification)
- #:use-module (srfi srfi-2)
- #:use-module (srfi srfi-26)
- #:export (delete-run-file
- main))
+
+;; 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)))
-;; Extract the actual command name from \a command. This returns the last
-;; part of \a command without any non-alphabetic characters. For example
-;; "in.cron" and "./mcron" will return respectively "cron" and "mcron".
+;; To determine the name of the program, scan the first item of the command line
+;; backwards for the first non-alphabetic character. This allows names like
+;; in.cron to be accepted as an invocation of the cron command.
+
+(use-modules (ice-9 regex) (ice-9 rdelim))
(define command-name (match:substring (regexp-exec (make-regexp "[[:alpha:]]*$")
(car (command-line)))))
@@ -41,49 +51,49 @@
;; Code contributed by Sergey Poznyakoff. Print an error message (made up from
-;; the parts of \a rest), and if the \a exit-code error is fatal (present and
-;; non-zero) then exit to the system with \a exit-code.
+;; the parts of rest), and if the error is fatal (present and non-zero) then
+;; exit to the system with this code.
(define (mcron-error exit-code . rest)
(with-output-to-port (current-error-port)
(lambda ()
- (for-each display
- (cons* command-name ": " rest))
+ (for-each display (append (list command-name ": ") rest))
(newline)))
- (when (and exit-code
- (not (eq? exit-code 0)))
- (primitive-exit exit-code)))
+ (if (and exit-code (not (eq? exit-code 0)))
+ (primitive-exit exit-code)))
-;; Code contributed by Sergey Poznyakoff and improved upon by Mathieu Lirzin
-;; with newer guile features. Execute the expressions. If an 'mcron-error
+;; Code contributed by Sergey Poznyakoff. Execute body. If an 'mcron-error
;; exception occurs, print its diagnostics and exit with its error code.
-(define-syntax-rule (catch-mcron-error exp ...)
- (catch 'mcron-error
- (lambda () exp ...)
- (lambda (key exit-code . msg)
- (apply mcron-error exit-code msg))))
+(defmacro catch-mcron-error (. body)
+ `(catch 'mcron-error
+ (lambda ()
+ ,@body)
+ (lambda (key exit-code . msg)
+ (apply mcron-error exit-code msg))))
-;; One of the symbols \c mcron, \c crond or \c crontab according to the means
-;; of our invocation.
+;; 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
- (let ((command=? (cute string=? command-name <>)))
- (cond ((command=? "mcron") 'mcron)
- ((or (command=? "cron") (command=? "crond")) 'cron)
- ((command=? "crontab") 'crontab)
- (else (mcron-error 12 "The command name is invalid.")))))
+(define command-type (cond ((string=? command-name "mcron") 'mcron)
+ ((or (string=? command-name "cron")
+ (string=? command-name "crond")) 'cron)
+ ((string=? command-name "crontab") 'crontab)
+ (else
+ (mcron-error 12 "The command name is invalid."))))
-;; There are a different set of options for the crontab personality compared
-;; to all the others, with the --help and --version options common to all the
+;; There are a different set of options for the crontab personality compared to
+;; all the others, with the --help and --version options common to all the
;; personalities.
+(use-modules (ice-9 getopt-long))
+
(define options
(catch
'misc-error
@@ -110,96 +120,129 @@
'((version (single-char #\v) (value #f))
(help (single-char #\h) (value #f))))))
(lambda (key func fmt args . rest)
- (mcron-error 1 (apply format (cons* #f fmt args))))))
-
-
+ (mcron-error 1 (apply format (append (list #f fmt) args))))))
+
+;; If the user asked for the version of this program, give it to him and get
+;; out.
+
+(if (option-ref options 'version #f)
+ (begin
+ (display (string-append "\n
+" command-name " (" config-package-string ")\n
+Written by Dale Mellor\n
+\n
+Copyright (C) 2003, 2006, 2014 Dale Mellor\n
+This is free software; see the source for copying conditions. There is NO\n
+warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n
+"))
+ (quit)))
+
+
+
+;; Likewise if the user requested the help text.
+
+(if (option-ref options 'help #f)
+ (begin
+ (display (string-append "
+Usage: " (car (command-line))
+(case command-type
+
+ ((mcron)
+" [OPTIONS] [FILES]\n
+Run an mcron process according to the specifications in the FILES (`-' for\n
+standard input), or use all the files in ~/.config/cron (or the \n
+deprecated ~/.cron) with .guile or .vixie extensions.\n
+\n
+ -v, --version Display version\n
+ -h, --help Display this help message\n
+ -sN, --schedule[=]N Display the next N jobs that will be run by mcron\n
+ -d, --daemon Immediately detach the program from the terminal\n
+ and run as a daemon process\n
+ -i, --stdin=(guile|vixie) Format of data passed as standard input or\n
+ file arguments (default guile)")
-;; Display version information for \a command and quit.
+ ((cron)
+" [OPTIONS]\n
+Unless an option is specified, run a cron daemon as a detached process, \n
+reading all the information in the users' crontabs and in /etc/crontab.\n
+\n
+ -v, --version Display version\n
+ -h, --help Display this help message\n
+ -sN, --schedule[=]N Display the next N jobs that will be run by cron\n
+ -n, --noetc Do not check /etc/crontab for updates (HIGHLY\n
+ RECOMMENDED).")
+
+ ((crontab)
+ (string-append " [-u user] file\n"
+ " " (car (command-line)) " [-u user] { -e | -l | -r }\n"
+ " (default operation is replace, per 1003.2)\n"
+ " -e (edit user's crontab)\n"
+ " -l (list user's crontab)\n"
+ " -r (delete user's crontab)\n"))
-(define* (show-version #:optional (command command-name))
- (let* ((name config-package-name)
- (short-name (cadr (string-split name #\space)))
- (version config-package-version))
- (simple-format #t "~a (~a) ~a
-Copyright (C) 2015 Free Software Foundation, Inc.
+ (else "rubbish"))
-License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>
-This is free software: you are free to change and redistribute it.
-There is NO WARRANTY, to the extent permitted by law.\n"
- command name version)
- (quit)))
+"\n\n
+Report bugs to " config-package-bugreport ".\n
+"))
+ (quit)))
-;; Display where to get help and send bug reports.
+;; This is called from the C front-end whenever a terminal signal is
+;; received. We remove the /var/run/cron.pid file so that crontab and other
+;; invocations of cron don't get the wrong idea that a daemon is currently
+;; running.
-(define (show-package-information)
- (simple-format #t "\nReport bugs to: ~a.
-~a home page: <~a>
-General help using GNU software: <http://www.gnu.org/gethelp/>\n"
- config-package-bugreport
- config-package-name
- config-package-url))
+(define (delete-run-file)
+ (catch #t (lambda () (delete-file config-pid-file)
+ (delete-file config-socket-file))
+ noop)
+ (quit))
-;; Display usage information and 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).
-(define (show-help)
- (simple-format #t "Usage: ~a" command-name)
- (display
- (case command-type
- ((mcron)
- " [OPTIONS] [FILES]
-Run an mcron process according to the specifications in the FILES (`-' for
-standard input), or use all the files in ~/.config/cron (or the
-deprecated ~/.cron) with .guile or .vixie extensions.
+(if (eq? command-type 'cron)
+ (begin
+ (if (not (eqv? (getuid) 0))
+ (mcron-error 16
+ "This program must be run by the root user (and should "
+ "have been installed as such)."))
+ (if (access? config-pid-file F_OK)
+ (mcron-error 1
+ "A cron daemon is already running.\n"
+ " (If you are sure this is not true, remove the file\n"
+ " "
+ config-pid-file
+ ".)"))
+ (if (not (option-ref options 'schedule #f))
+ (with-output-to-file config-pid-file noop))
+ (setenv "MAILTO" #f)
+ (c-set-cron-signals)))
- -v, --version Display version
- -h, --help Display this help message
- -sN, --schedule[=]N Display the next N jobs that will be run by mcron
- -d, --daemon Immediately detach the program from the terminal
- and run as a daemon process
- -i, --stdin=(guile|vixie) Format of data passed as standard input or
- file arguments (default guile)")
- ((cron)
- " [OPTIONS]
-Unless an option is specified, run a cron daemon as a detached process,
-reading all the information in the users' crontabs and in /etc/crontab.
-
- -v, --version Display version
- -h, --help Display this help message
- -sN, --schedule[=]N Display the next N jobs that will be run by cron
- -n, --noetc Do not check /etc/crontab for updates (HIGHLY
- RECOMMENDED).")
- ((crontab)
- " [-u user] file
- crontab [-u user] { -e | -l | -r }
- (default operation is replace, per 1003.2)
- -e (edit user's crontab)
- -l (list user's crontab)
- -r (delete user's crontab)")
- (else "\nrubbish")))
- (newline)
- (show-package-information)
- (quit))
+;; Define the functions available to the configuration files. While we're here,
+;; we'll get the core loaded as well.
-;; Remove the /var/run/cron.pid file so that crontab and other invocations of
-;; cron don't get the wrong idea that a daemon is currently running. This
-;; procedure is called from the C front-end whenever a terminal signal is
-;; received.
+(use-modules (mcron core)
+ (mcron job-specifier)
+ (mcron vixie-specification))
-(define (delete-run-file)
- (catch #t (lambda () (delete-file config-pid-file)
- (delete-file config-socket-file))
- noop)
- (quit))
-
-;; Return standard input as a string.
+;; Procedure to slurp the standard input into a string.
(define (stdin->string)
(with-output-to-string (lambda () (do ((in (read-char) (read-char)))
@@ -208,83 +251,183 @@ reading all the information in the users' crontabs and in /etc/crontab.
-;; Return a thunk which process each file in \a directory with \a proc. The
-;; \a directory must be a directory name. The \a proc argument must be a
-;; procedure that takes one file name argument.
+;; 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)))
+
+
-(define (proc-in-directory directory proc)
- (let ((dir (opendir directory)))
- (do ((file-name (readdir dir) (readdir dir)))
- ((eof-object? file-name) (closedir dir))
- (proc file-name))))
+;; Code contributed by Sergey Poznyakoff. Determine if the given file is a
+;; regular file or not.
+(define (regular-file? file)
+ (catch 'system-error
+ (lambda ()
+ (eq? (stat:type (stat file)) 'regular))
+ (lambda (key call fmt args . rest)
+ (mcron-error 0 (apply format (append (list #f fmt) args)))
+ #f)))
-;; Process \a file-name according its extension. When \a guile-syntax? is \c
-;; TRUE, force guile syntax usage. If \a file-name format is not recognized,
-;; it is silently ignored (this deals properly with most editors' backup
-;; files, for instance).
-(define process-user-file
- (let ((guile-regexp (make-regexp "\\.gui(le)?$"))
- (vixie-regexp (make-regexp "\\.vix(ie)?$")))
- (lambda* (file-path #:optional assume-guile)
- (cond ((string=? "-" file-path)
- (if (string=? (option-ref options 'stdin "guile") "vixie")
- (read-vixie-port (current-input-port))
- (eval-string (stdin->string))))
- ((regexp-exec vixie-regexp file-path)
- (read-vixie-file file-path))
- ((or assume-guile
- (regexp-exec guile-regexp file-path))
- (load file-path))))))
+;; Procedure which processes any configuration file according to the
+;; extension. If a file is not recognized, it is silently ignored (this deals
+;; properly with most editors' backup files, for instance).
+(define guile-file-regexp (make-regexp "\\.gui(le)?$"))
+(define vixie-file-regexp (make-regexp "\\.vix(ie)?$"))
+(define (process-user-file file-path . assume-guile)
+ (cond ((string=? file-path "-")
+ (if (string=? (option-ref options 'stdin "guile") "vixie")
+ (read-vixie-port (current-input-port))
+ (eval-string (stdin->string))))
+ ((or (not (null? assume-guile))
+ (regexp-exec guile-file-regexp file-path))
+ (load file-path))
+ ((regexp-exec vixie-file-regexp file-path)
+ (read-vixie-file file-path))))
-;; Process files in $XDG_CONFIG_HOME/cron and/or ~/.cron directories (if
-;; $XDG_CONFIG_HOME is not defined uses ~/.config/cron instead).
+
+
+;; Procedure to run through all the files in a user's ~/.cron and/or
+;; $XDG_CONFIG_HOME/cron or ~/.config/cron directories (only happens under the
+;; mcron personality).
(define (process-files-in-user-directory)
(let ((errors 0)
(home-directory (passwd:dir (getpw (getuid)))))
- (map (lambda (dir)
- (catch #t
- (lambda ()
- (proc-in-directory
- dir
- (lambda (file-name)
- (process-user-file (string-append dir "/" file-name)))))
- (lambda (key . args)
- (set! errors (1+ errors)))))
- (list (string-append home-directory "/.cron")
- (string-append (or (getenv "XDG_CONFIG_HOME")
- (string-append home-directory "/.config"))
- "/cron")))
- (when (eq? 2 errors)
- (mcron-error 13
- "Cannot read files in your ~/.config/cron (or ~/.cron) directory."))))
-
-
-
-;; Process all the files in the crontab directory. When the job procedure is
-;; run on behalf of the configuration files, the jobs are registered on the
-;; system with the appropriate user. Only root should be able to perform this
-;; operation. The permissions on the /var/cron/tabs directory enforce this.
+ (map (lambda (config-directory)
+ (catch #t
+ (lambda ()
+ (let ((directory (opendir config-directory)))
+ (do ((file-name (readdir directory) (readdir directory)))
+ ((eof-object? file-name) (closedir directory))
+ (process-user-file (string-append config-directory
+ "/"
+ file-name)))))
+ (lambda (key . args)
+ (set! errors (1+ errors)))))
+ (list (string-append home-directory "/.cron")
+ (string-append (or (getenv "XDG_CONFIG_HOME")
+ (string-append home-directory "/.config"))
+ "/cron")))
+ (if (eq? 2 errors)
+ (mcron-error 13
+ "Cannot read files in your ~/.config/cron (or ~/.cron) "
+ "directory."))))
+
+
+
+;; Procedure to check that a user name is in the passwd database (it may happen
+;; that a user is removed after creating a crontab). If the user name is valid,
+;; the full passwd entry for that user is returned to the caller.
+
+(define (valid-user user-name)
+ (setpwent)
+ (do ((entry (getpw) (getpw)))
+ ((or (not entry)
+ (string=? (passwd:name entry) user-name))
+ (endpwent)
+ entry)))
+
+
+
+;; Procedure to process all the files in the crontab directory, making sure that
+;; each file is for a legitimate user and setting the configuration-user to that
+;; user. In this way, when the job procedure is run on behalf of the
+;; configuration files, the jobs are registered with the system with the
+;; appropriate user. Note that only the root user should be able to perform this
+;; operation, but we leave it to the permissions on the /var/cron/tabs directory
+;; to enforce this.
+
+(use-modules (srfi srfi-2)) ;; For and-let*.
(define (process-files-in-system-directory)
(catch #t
- (lambda ()
- (proc-in-directory
- config-spool-dir
- (lambda (user-name)
- (and-let* ((user (false-if-exception (getpwnam user-name))))
- (set-configuration-user user)
- (catch-mcron-error
- (read-vixie-file
- (string-append config-spool-dir "/" user-name)))))))
- (lambda (key . args)
- (mcron-error 4
- "You do not have permission to access the system crontabs."))))
+ (lambda ()
+ (let ((directory (opendir config-spool-dir)))
+ (do ((file-name (readdir directory) (readdir directory)))
+ ((eof-object? file-name))
+ (and-let* ((user (valid-user file-name)))
+ (set-configuration-user user) ;; / ?? !!!!
+ (catch-mcron-error
+ (read-vixie-file (string-append config-spool-dir
+ "/"
+ file-name)))))))
+ (lambda (key . args)
+ (mcron-error
+ 4
+ "You do not have permission to access the system crontabs."))))
+
+
+
+;; Having defined all the necessary procedures for scanning various sets of
+;; files, we perform the actual configuration of the program depending on the
+;; personality we are running as. If it is mcron, we either scan the files
+;; passed on the command line, or else all the ones in the user's .config/cron
+;; (or .cron) directory. If we are running under the cron personality, we read
+;; the /var/cron/tabs directory and also the /etc/crontab file.
+
+(case command-type
+ ((mcron) (if (null? (option-ref options '() '()))
+ (process-files-in-user-directory)
+ (for-each (lambda (file-path)
+ (process-user-file file-path #t))
+ (option-ref options '() '()))))
+
+ ((cron) (process-files-in-system-directory)
+ (use-system-job-list)
+ (catch-mcron-error
+ (read-vixie-file "/etc/crontab" parse-system-vixie-line))
+ (use-user-job-list)
+ (if (not (option-ref options 'noetc #f))
+ (begin
+ (display
+"WARNING: cron will check for updates to /etc/crontab EVERY MINUTE. If you do\n
+not use this file, or you are prepared to manually restart cron whenever you\n
+make a change, then it is HIGHLY RECOMMENDED that you use the --noetc\n
+option.\n")
+ (set-configuration-user "root")
+ (job '(- (next-minute-from (next-minute)) 6)
+ check-system-crontab
+ "/etc/crontab update checker.")))))
+
+
+
+;; If the user has requested a schedule of jobs that will run, we provide the
+;; information here and then get out.
+;;
+;; Start by determining the number of time points in the future that output is
+;; required for. This may be provided on the command line as a parameter to the
+;; --schedule option, or else we assume a default of 8. Finally, ensure that the
+;; count is some positive integer.
+
+(and-let* ((count (option-ref options 'schedule #f)))
+ (set! count (string->number count))
+ (display (get-schedule (if (<= count 0) 1 count)))
+ (quit))
+
+
+
+;; If we are supposed to run as a daemon process (either a --daemon option has
+;; been explicitly used, or we are running as cron or crond), detach from the
+;; terminal now. If we are running as cron, we can now write the PID file.
+
+(if (option-ref options 'daemon (eq? command-type 'cron))
+ (begin
+ (if (not (eqv? (primitive-fork) 0))
+ (quit))
+ (setsid)
+ (if (eq? command-type 'cron)
+ (with-output-to-file config-pid-file
+ (lambda () (display (getpid)) (newline))))))
@@ -293,30 +436,32 @@ reading all the information in the users' crontabs and in /etc/crontab.
;; inform the main wait-run-wait execution loop to listen for incoming messages
;; on this socket.
-(define (cron-file-descriptors)
- (if (eq? command-type 'cron)
- (catch #t
- (lambda ()
- (let ((socket (socket AF_UNIX SOCK_STREAM 0)))
- (bind socket AF_UNIX config-socket-file)
- (listen socket 5)
- (list socket)))
- (lambda (key . args)
- (delete-file config-pid-file)
- (mcron-error 1
- "Cannot bind to UNIX socket " config-socket-file)))
- '()))
+(define fd-list '())
+(if (eq? command-type 'cron)
+ (catch #t
+ (lambda ()
+ (let ((socket (socket AF_UNIX SOCK_STREAM 0)))
+ (bind socket AF_UNIX config-socket-file)
+ (listen socket 5)
+ (set! fd-list (list socket))))
+ (lambda (key . args)
+ (delete-file config-pid-file)
+ (mcron-error 1
+ "Cannot bind to UNIX socket "
+ config-socket-file))))
+
-;; Read a user name from the socket, dealing with the /etc/crontab special
+
+;; 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 drop all the system jobs and
-;; re-read the /etc/crontab file. This function should be called whenever a
-;; message comes in on the above socket.
+;; 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 fd-list)
- (let* ((socket (car (accept (car fd-list))))
+(define (process-update-request)
+ (let* ((socket (car (accept (car fd-list))))
(user-name (read-line socket)))
(close socket)
(set-configuration-time (current-time))
@@ -330,123 +475,29 @@ reading all the information in the users' crontabs and in /etc/crontab.
(let ((user (getpw user-name)))
(remove-user-jobs user)
(set-configuration-user user)
- (read-vixie-file
- (string-append config-spool-dir "/" user-name)))))))
+ (read-vixie-file (string-append config-spool-dir "/" user-name)))))))
-;; Entry point.
-;;
-;; This is the 'main' routine for the whole system; this module is the global
-;; entry point (after the minimal C wrapper); to all intents and purposes the
-;; program is pure Guile and starts here.
-
-(define (main . args)
- ;; Added by Sergey Poznyakoff. This no-op will collect zombie child processes
- ;; as soon as they die. This is a big improvement as previously they stayed
- ;; around the system until the next time mcron wakes to fire a new job off.
- (when config-debug
- (debug-enable 'backtrace))
- (when (option-ref options 'version #f)
- (show-version))
- (when (option-ref options 'help #f)
- (show-help))
-
- ;; 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).
- (when (eq? command-type 'cron)
- (unless (eqv? (getuid) 0)
- (mcron-error 16
- "This program must be run by the root user (and should have been "
- "installed as such)."))
- (when (access? config-pid-file F_OK)
- (mcron-error 1
- "A cron daemon is already running.\n (If you are sure this is not"
- " true, remove the file\n " config-pid-file ".)"))
- (unless (option-ref options 'schedule #f)
- (with-output-to-file config-pid-file noop))
- (setenv "MAILTO" #f)
- ;; Mathieu Lirzin: At compile time, this yields a "possibly unbound
- ;; variable" warning, but this is OK since it is bound in the C wrapper.
- (c-set-cron-signals))
-
- ;; 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.
- (when (eq? command-type 'crontab)
- (load "crontab.scm")
- (quit))
-
- ;; Having defined all the necessary procedures for scanning various sets of
- ;; files, we perform the actual configuration of the program depending on
- ;; the personality we are running as. If it is mcron, we either scan the
- ;; files passed on the command line, or else all the ones in the user's
- ;; .config/cron (or .cron) directory. If we are running under the cron
- ;; personality, we read the /var/cron/tabs directory and also the
- ;; /etc/crontab file.
- (case command-type
- ((mcron)
- (if (null? (option-ref options '() '()))
- (process-files-in-user-directory)
- (for-each (lambda (file-path) (process-user-file file-path
- 'guile-syntax))
- (option-ref options '() '()))))
- ((cron)
- (process-files-in-system-directory)
- (use-system-job-list)
- (catch-mcron-error (read-vixie-file "/etc/crontab"
- parse-system-vixie-line))
- (use-user-job-list)
- (unless (option-ref options 'noetc #f)
- (display "\
-WARNING: cron will check for updates to /etc/crontab EVERY MINUTE. If you do
-not use this file, or you are prepared to manually restart cron whenever you
-make a change, then it is HIGHLY RECOMMENDED that you use the --noetc
-option.\n")
- (set-configuration-user "root")
- (job '(- (next-minute-from (next-minute)) 6)
- check-system-crontab
- "/etc/crontab update checker."))))
-
- ;; If the user has requested a schedule of jobs that will run, we provide
- ;; the information here and then get out. Start by determining the number
- ;; of time points in the future that output is required for. This may be
- ;; provided on the command line as a parameter to the --schedule option, or
- ;; else we assume a default of 8. Finally, ensure that the count is some
- ;; positive integer.
- (and-let* ((count (option-ref options 'schedule #f)))
- (set! count (string->number count))
- (display (get-schedule (max 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.
- (when (option-ref options 'daemon (eq? command-type 'cron))
- (unless (eqv? (primitive-fork) 0)
- (quit))
- (setsid)
- (when (eq? command-type 'cron)
- (with-output-to-file config-pid-file
- (lambda () (display (getpid)) (newline)))))
-
- ;; Now the main loop. Forever execute the run-job-loop procedure in the
- ;; mcron core, and when it drops out (can only be because a message has come
- ;; in on the socket) we process the socket request before restarting the
- ;; loop again. Sergey Poznyakoff: we can also drop out of run-job-loop
- ;; because of a SIGCHLD, so must test fd-list.
- (catch-mcron-error
- (let ((fd-list (cron-file-descriptors)))
- (while #t
- (run-job-loop fd-list)
- (unless (null? fd-list)
- (process-update-request fd-list))))))
+
+;; Added by Sergey Poznyakoff. This no-op will collect zombie child processes
+;; as soon as they die. This is a big improvement as previously they stayed
+;; around the system until the next time mcron wakes to fire a new job off.
+
+;; Unfortunately it seems to interact badly with the select system call,
+;; wreaking havoc...
+
+;; (sigaction SIGCHLD (lambda (sig) noop) SA_RESTART)
+
+
+
+;; Now the main loop. Forever execute the run-job-loop procedure in the mcron
+;; core, and when it drops out (can only be because a message has come in on the
+;; socket) we process the socket request before restarting the loop again.
+;; Sergey Poznyakoff: we can also drop out of run-job-loop because of a SIGCHLD,
+;; so must test fd-list.
+
+(catch-mcron-error
+ (while #t
+ (run-job-loop fd-list)
+ (if (not (null? fd-list))
+ (process-update-request))))