From a7a456cd6fab22eab69303a4430edf5501187299 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Tue, 24 Aug 2021 00:20:50 -0400 Subject: base: Annotate output with job information. Before this change, it was difficult to discern which job emitted which output, as there was no information connecting the job to the output it produced. This change rectifies that by annotating each line output by cron/mcron with a prefix that contains a timestamp and the job name. It also reports about when the job runs and whether it completed successfully or failed. It was initially suggested here: . Thanks to the fine people from the #guile libera.chat IRC channel for providing ideas and help; this change would not have been possible without them! * src/mcron/base.scm (install-suspendable-ports!): Install suspendable ports. (%date-format, %log-format): New parameters. (validate-date-format, validate-log-format): New procedures. (): New record. (run-job): Update doc. Redirect stdout and stderr to a pipe. Return a instance containing the input port and other information about the job. Output job status messages. (process-output): New procedure. (child-cleanup): Add docstring. Use positive logic. Call 'process-output' one last time after a child process is collected. (run-job-loop): Add a CHILDREN-DATA variable to the loop. Provide the open file descriptors of the children ports to select*, and collect their output when they trigger select. * tests/base.scm ("run-job: basic"): Adjust and fix indentation. (dummy-job/capture-output): New procedure. ("run-job, output"): New test. ("validate-date-format, valid", "validate-date-format, invalid") ("validate-log-format, valid", "validate-log-format, invalid") ("run-job, output with custom format", "run-job, failure") ("run-job, failure in shell action"): New tests. * src/mcron/scripts/cron.scm (show-help): Document new options. (%options) [log-format, date-format]: New options. (main): Parameterize the main loop with the new parameter options (or their default values when not provided); move exception handling elsewhere (see below). * src/mcron/scripts/mcron.scm: Likewise. * src/cron.in: Install error handler here. * src/mcron.in: Likewise. * doc/mcron.texi: Document new cron and mcron options, as well as new (mcron base) APIs. * tests/basic.sh: Test the new options. Suggested-by: Robert Vollmert --- src/mcron/scripts/cron.scm | 77 +++++++++++++++++++++++++-------------------- src/mcron/scripts/mcron.scm | 20 ++++++------ 2 files changed, 52 insertions(+), 45 deletions(-) (limited to 'src/mcron/scripts') diff --git a/src/mcron/scripts/cron.scm b/src/mcron/scripts/cron.scm index 25c8a1a..a0c9a68 100644 --- a/src/mcron/scripts/cron.scm +++ b/src/mcron/scripts/cron.scm @@ -1,6 +1,7 @@ ;;;; cron -- daemon for running jobs at scheduled times ;;; Copyright © 2003, 2012 Dale Mellor ;;; Copyright © 2015, 2016, 2018 Mathieu Lirzin +;;; Copyright © 2021 Maxim Cournoyer ;;; ;;; This file is part of GNU Mcron. ;;; @@ -40,7 +41,9 @@ reading all the information in the users' crontabs and in /etc/crontab. -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).") + RECOMMENDED). + --log-format=FMT (ice-9 format) format string for log messages + --date-format=FMT (srfi srfi-19) date format string for log messages") (newline) (show-package-information)) @@ -49,6 +52,8 @@ reading all the information in the users' crontabs and in /etc/crontab. (define %options `((schedule (single-char #\s) (value #t) (predicate ,string->number)) (noetc (single-char #\n) (value #f)) + (log-format (value #t) (predicate ,validate-log-format)) + (date-format (value #t) (predicate ,validate-date-format)) (version (single-char #\v) (value #f)) (help (single-char #\h) (value #f)))) @@ -142,31 +147,34 @@ option.\n") ;;; (define* (main #:optional (args (command-line))) - (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) - => (λ (count) - (display-schedule (max 1 (string->number count))) - (exit 0))))))) + + (define 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) + => (λ (count) + (display-schedule (max 1 (string->number count))) + (exit 0)))))) ;; Daemonize ourself. (unless (eq? 0 (primitive-fork)) (exit 0)) @@ -187,11 +195,12 @@ option.\n") (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)))))) + (parameterize ((%log-format (option-ref opts 'log-format (%log-format))) + (%date-format (option-ref opts 'date-format (%date-format)))) + ;; 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. + (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/mcron.scm b/src/mcron/scripts/mcron.scm index a6b1fa2..300aad0 100644 --- a/src/mcron/scripts/mcron.scm +++ b/src/mcron/scripts/mcron.scm @@ -1,6 +1,7 @@ ;;;; mcron -- run jobs at scheduled times ;;; Copyright © 2003, 2012 Dale Mellor ;;; Copyright © 2015, 2016, 2018 Mathieu Lirzin +;;; Copyright © 2021 Maxim Cournoyer ;;; ;;; This file is part of GNU Mcron. ;;; @@ -41,6 +42,8 @@ standard input), or use all the files in ~/.config/cron (or the deprecated -i, --stdin=(guile|vixie) Format of data passed as standard input (default guile) -s, --schedule[=N] Display the next N (or 8) jobs that will be run + --log-format=FMT (ice-9 format) format string for log messages + --date-format=FMT (srfi srfi-19) date format string for log messages -?, --help Give this help list -V, --version Print program version @@ -119,6 +122,8 @@ directory. Double-check the folder and file permissions and syntax.")))) (string=? in "vixie"))))) (schedule (single-char #\s) (value optional) (predicate ,string->number)) + (log-format (value #t) (predicate ,validate-log-format)) + (date-format (value #t) (predicate ,validate-date-format)) (help (single-char #\?)) (version (single-char #\V)))))) @@ -141,14 +146,7 @@ directory. Double-check the folder and file permissions and syntax.")))) ((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))))))) + (parameterize + ((%log-format (option-ref options 'log-format (%log-format))) + (%date-format (option-ref options 'date-format (%date-format)))) + (run-job-loop)))) -- cgit v1.2.3