diff options
Diffstat (limited to 'src/mcron/scripts')
| -rw-r--r-- | src/mcron/scripts/cron.scm | 114 | ||||
| -rw-r--r-- | src/mcron/scripts/crontab.scm | 4 | ||||
| -rw-r--r-- | src/mcron/scripts/mcron.scm | 116 |
3 files changed, 151 insertions, 83 deletions
diff --git a/src/mcron/scripts/cron.scm b/src/mcron/scripts/cron.scm index 1a97fdf..25c8a1a 100644 --- a/src/mcron/scripts/cron.scm +++ b/src/mcron/scripts/cron.scm @@ -17,6 +17,7 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Mcron. If not, see <http://www.gnu.org/licenses/>. + (define-module (mcron scripts cron) #:use-module (ice-9 getopt-long) #:use-module (ice-9 ftw) @@ -28,6 +29,8 @@ #:use-module (srfi srfi-2) #:export (main)) + + (define (show-help) (display "Usage: cron [OPTIONS] Unless an option is specified, run a cron daemon as a detached process, @@ -41,12 +44,15 @@ reading all the information in the users' crontabs and in /etc/crontab. (newline) (show-package-information)) -(define %options - `((schedule (single-char #\s) (value #t) - (predicate ,(λ (str) (string->number str)))) - (noetc (single-char #\n) (value #f)) - (version (single-char #\v) (value #f)) - (help (single-char #\h) (value #f)))) + + +(define %options `((schedule (single-char #\s) (value #t) + (predicate ,string->number)) + (noetc (single-char #\n) (value #f)) + (version (single-char #\v) (value #f)) + (help (single-char #\h) (value #f)))) + + (define (delete-run-file) "Remove the /var/run/cron.pid file so that crontab and other invocations of @@ -60,6 +66,8 @@ received." noop) (quit)) + + (define (cron-file-descriptors) "Establish a socket to listen for updates from a crontab program, and return a list containing the file descriptors correponding to the files read by @@ -74,6 +82,8 @@ crontab. This requires that command-type is 'cron." (delete-file config-pid-file) (mcron-error 1 "Cannot bind to UNIX socket " config-socket-file)))) + + (define (process-files-in-system-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 @@ -103,9 +113,6 @@ operation. The permissions on the /var/cron/tabs directory enforce this." (with-output-to-file config-pid-file noop)) ;; Clear MAILTO so that outputs are sent to the various users. (setenv "MAILTO" #f) - ;; XXX: 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) ;; 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 @@ -138,42 +145,53 @@ option.\n") (let ((opts (getopt-long args %options))) (when config-debug (debug-enable 'backtrace)) - (cond - ((option-ref opts 'help #f) - (show-help) - (exit 0)) - ((option-ref opts 'version #f) - (show-version "cron") - (exit 0)) - ((not (zero? (getuid))) - (mcron-error 16 - "This program must be run by the root user (and should" - " have been installed as such).")) - ((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 ".)")) - (else - (%process-files (option-ref opts 'schedule #f) - (option-ref opts 'noetc #f)) - (cond ((option-ref opts 'schedule #f) ;display jobs schedule - => (λ (count) - (display-schedule (max 1 (string->number count))) - (exit 0))) - (else (case (primitive-fork) ;run the daemon - ((0) - (setsid) - ;; we can now write the PID file. - (with-output-to-file config-pid-file - (λ () (display (getpid)) (newline)))) - (else (exit 0))))) - ;; Forever execute the 'run-job-loop', 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. - (catch-mcron-error - (let ((fdes-list (cron-file-descriptors))) - (while #t - (run-job-loop fdes-list) - (unless (null? fdes-list) - (process-update-request fdes-list))))))))) + (cond ((option-ref opts 'help #f) + (show-help) + (exit 0)) + ((option-ref opts 'version #f) + (show-version "cron") + (exit 0)) + ((not (zero? (getuid))) + (mcron-error 16 + "This program must be run by the root user (and should" + " have been installed as such).")) + ((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 ".)")) + (else + (%process-files (option-ref opts 'schedule #f) + (option-ref opts 'noetc #f)) + (cond ((option-ref opts 'schedule #f) + => (λ (count) + (display-schedule (max 1 (string->number count))) + (exit 0))))))) + + ;; Daemonize ourself. + (unless (eq? 0 (primitive-fork)) (exit 0)) + (setsid) + + ;; Set up process signal handlers, as signals are the only way to terminate + ;; the daemon and we MUST be graceful in defeat. + (for-each (λ (x) (sigaction x + (λ (sig) (catch #t + (λ () + (delete-file config-pid-file) + (delete-file config-socket-file)) + noop) + (exit EXIT_FAILURE)))) + '(SIGTERM SIGINT SIGQUIT SIGHUP)) + + ;; We can now write the PID file. + (with-output-to-file config-pid-file + (λ () (display (getpid)) (newline))) + + ;; Forever execute the 'run-job-loop', 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. + (catch-mcron-error + (let ((fdes-list (cron-file-descriptors))) + (while #t + (run-job-loop fdes-list) + (unless (null? fdes-list) (process-update-request fdes-list)))))) diff --git a/src/mcron/scripts/crontab.scm b/src/mcron/scripts/crontab.scm index 902d3fc..480eadc 100644 --- a/src/mcron/scripts/crontab.scm +++ b/src/mcron/scripts/crontab.scm @@ -25,13 +25,13 @@ #:use-module (mcron vixie-specification) #:export (main)) -(define* (show-help) +(define (show-help) (display "Usage: 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") + -r (delete user's crontab)") (newline) (show-package-information)) diff --git a/src/mcron/scripts/mcron.scm b/src/mcron/scripts/mcron.scm index 6545ada..0da1cdf 100644 --- a/src/mcron/scripts/mcron.scm +++ b/src/mcron/scripts/mcron.scm @@ -19,13 +19,40 @@ (define-module (mcron scripts mcron) #:use-module (ice-9 ftw) + #:use-module (ice-9 getopt-long) + #:use-module (ice-9 local-eval) + #:use-module (ice-9 rdelim) #:use-module (mcron base) #:use-module (mcron config) - #:use-module (mcron job-specifier) ;for user/system files + #:use-module (mcron job-specifier) ; For user/system files. #:use-module (mcron utils) #:use-module (mcron vixie-specification) #:export (main)) + + +(define (show-help) + (display "Usage: mcron [OPTION...] [FILE...] +Run an mcron process according to the specifications in the FILE... (`-' for +standard input), or use all the files in ~/.config/cron (or the deprecated +~/.cron) with .guile or .vixie extensions. + + -d, --daemon Run as a daemon process + -i, --stdin=(guile|vixie) Format of data passed as standard input or file + arguments (default guile) + -s, --schedule[=N] Display the next N (or 8) jobs that will be run + -?, --help Give this help list + -V, --version Print program version + +Mandatory or optional arguments to long options are also mandatory or optional +for any corresponding short options. + +Report bugs to bug-mcron@gnu.org. + +")) + + + (define process-user-file (let ((guile-regexp (make-regexp "\\.gui(le)?$")) (vixie-regexp (make-regexp "\\.vix(ie)?$"))) @@ -34,13 +61,17 @@ force guile syntax usage. If FILE-NAME format is not recognized, it is silently ignored." (cond ((string=? "-" file-name) - (if (string=? input "vixie") - (read-vixie-port (current-input-port)) - (eval-string (read-string)))) + (if (string=? input "vixie") + (read-vixie-port (current-input-port)) + (eval-string (read-string) + (resolve-module '(mcron job-specifier))))) ((or guile-syntax? (regexp-exec guile-regexp file-name)) - (load file-name)) + (eval-string (read-delimited "" (open-input-file file-name)) + (resolve-module '(mcron job-specifier)))) ((regexp-exec vixie-regexp file-name) - (read-vixie-file file-name)))))) + (read-vixie-file file-name)))))) + + (define (process-files-in-user-directory input-type) "Process files in $XDG_CONFIG_HOME/cron and/or ~/.cron directories (if @@ -64,6 +95,8 @@ $XDG_CONFIG_HOME is not defined uses ~/.config/cron instead)." (mcron-error 13 "Cannot read files in your ~/.config/cron (or ~/.cron) directory.")))) + + (define (%process-files files input-type) (if (null? files) (process-files-in-user-directory input-type) @@ -74,30 +107,47 @@ $XDG_CONFIG_HOME is not defined uses ~/.config/cron instead)." ;;; Entry point. ;;; -(define* (main #:optional (opts '())) - (when config-debug - (debug-enable 'backtrace)) - - (%process-files (or (assq-ref opts 'files) '()) - (if (assq-ref opts 'vixie) "vixie" "guile")) - - (cond ((assq-ref opts 'schedule) ;display jobs schedule - => (λ (count) - (display-schedule (max 1 count)) - (exit 0))) - ((assq-ref opts 'daemon) ;run mcron as a daemon - (case (primitive-fork) - ((0) (setsid)) - (else (exit 0))))) - - ;; Forever execute the 'run-job-loop', 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. - (catch-mcron-error - (let ((fdes-list '())) - (while #t - (run-job-loop fdes-list) - ;; we can also drop out of run-job-loop because of a SIGCHLD, - ;; so must test FDES-LIST. - (unless (null? fdes-list) - (process-update-request fdes-list)))))) +(define (main) + + (let ((options + (getopt-long + (command-line) + `((daemon (single-char #\d) (value #f)) + (stdin (single-char #\i) (value #t) + (predicate ,(λ (in) (or (string=? in "guile") + (string=? in "vixie"))))) + (schedule (single-char #\s) (value optional) + (predicate ,string->number)) + (help (single-char #\?)) + (version (single-char #\V)))))) + + (cond ((option-ref options 'help #f) (show-help) (exit 0)) + ((option-ref options 'version #f) (show-version "mcron") (exit 0))) + + (when config-debug + (debug-enable 'backtrace)) + + (%process-files (option-ref options '() '()) + (option-ref options 'stdin "guile")) + + (cond ((option-ref options 'schedule #f) + => (λ (count) + (let ((c (if (string? count) (string->number count) 8))) + (display-schedule (if (exact-integer? c) (max 1 c) 8))) + (exit 0))) + ((option-ref options 'daemon #f) + (case (primitive-fork) + ((0) (setsid)) + (else (exit 0))))) + + ;; Forever execute the 'run-job-loop', 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. + (catch-mcron-error + (let ((fdes-list '())) + (while #t + (run-job-loop fdes-list) + ;; we can also drop out of run-job-loop because of a SIGCHLD, + ;; so must test FDES-LIST. + (unless (null? fdes-list) + (process-update-request fdes-list))))))) |