From e2ecb8045bc9789b109b1e7e0b282269a33ca9fb Mon Sep 17 00:00:00 2001 From: Dale Mellor Date: Thu, 7 Jul 2022 16:51:31 +0100 Subject: Give mcron --log option to turn logging on. This makes the behaviour backwards compatible with all previous uses of mcron. * src/mcron/base.scm: establish %do-logging parameter and act on it * src/mcron/scripts/mcron.scm: set %do-logging according to command line * tests/base.scm: some tests require %do-logging to be set --- src/mcron/base.scm | 21 ++++++++++++++++----- src/mcron/scripts/mcron.scm | 5 ++++- tests/base.scm | 18 ++++++++++-------- 3 files changed, 30 insertions(+), 14 deletions(-) diff --git a/src/mcron/base.scm b/src/mcron/base.scm index 6e325f7..79a88a6 100644 --- a/src/mcron/base.scm +++ b/src/mcron/base.scm @@ -45,6 +45,7 @@ display-schedule run-job-loop + %do-logging %date-format %log-format validate-date-format @@ -85,6 +86,8 @@ (user schedule-user set-schedule-user!) ;list of (current schedule-current set-schedule-current!)) ;symbol 'user or 'system +(define %do-logging (make-parameter #f)) + ;; A (srfi srfi-19) format string for the date. It is used to format the ;; timestamp argument. Defaults to the local ISO-8601 date/time format. (define %date-format (make-parameter "~5")) @@ -284,7 +287,8 @@ streams can be read as well as the name of the job." ;; Execute the action. (catch #t (lambda () - (format #t "running...~%") + (if (%do-logging) + (format #t "running...~%")) (flush-all-ports) (let* ((result ((job:action job))) (exit-val/maybe (false-if-exception @@ -292,7 +296,8 @@ streams can be read as well as the name of the job." (when (and exit-val/maybe (not (= 0 exit-val/maybe))) (error "unclean exit status" exit-val/maybe))) - (format #t "completed in ~,3fs~%" (seconds-since start)) + (if (%do-logging) + (format #t "completed in ~,3fs~%" (seconds-since start))) (flush-all-ports) (primitive-exit 0)) (lambda args @@ -354,7 +359,11 @@ associated instance." (cons 'suspended partial-continuation)))) (define (format-line line) - (format #t "~@?" (%log-format) timestamp pid name line)) + (cond ((%do-logging) + (format #t "~@?" (%log-format) timestamp pid name line)) + ((and (string? line) + (not (string-null? line))) + (display line)))) (let loop ((line+delim (read-line*))) (match line+delim @@ -367,8 +376,10 @@ associated instance." (("" . #\cr) ;; A carriage return directly followed a delimiter. Ignore it. (loop (read-line*))) - ((line . _) - (format-line line) + ((line . delim) + (format-line (if (%do-logging) + line + (string-append line (string delim)))) (loop (read-line*))))))) (for-each log-data diff --git a/src/mcron/scripts/mcron.scm b/src/mcron/scripts/mcron.scm index 300aad0..11c0e34 100644 --- a/src/mcron/scripts/mcron.scm +++ b/src/mcron/scripts/mcron.scm @@ -42,6 +42,7 @@ 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 + -l, --log Write log messages to standard output --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 @@ -122,6 +123,7 @@ directory. Double-check the folder and file permissions and syntax.")))) (string=? in "vixie"))))) (schedule (single-char #\s) (value optional) (predicate ,string->number)) + (log (single-char #\l) (value #f)) (log-format (value #t) (predicate ,validate-log-format)) (date-format (value #t) (predicate ,validate-date-format)) (help (single-char #\?)) @@ -147,6 +149,7 @@ directory. Double-check the folder and file permissions and syntax.")))) (else (exit 0))))) (parameterize - ((%log-format (option-ref options 'log-format (%log-format))) + ((%do-logging (option-ref options 'log (%do-logging))) + (%log-format (option-ref options 'log-format (%log-format))) (%date-format (option-ref options 'date-format (%date-format)))) (run-job-loop)))) diff --git a/tests/base.scm b/tests/base.scm index 914b4c6..7d7b6d7 100644 --- a/tests/base.scm +++ b/tests/base.scm @@ -234,13 +234,14 @@ (sigaction SIGCHLD SIG_DFL)))))) (test-assert "run-job, output" - (let ((output (dummy-job/capture-output - (lambda () - (format #t "output line 1~%") - (format #t "output line 2\nand 3~%") - (system "echo poutine") - (format (current-error-port) - "some error~%"))))) + (let ((output (parameterize ((%do-logging #t)) + (dummy-job/capture-output + (lambda () + (format #t "output line 1~%") + (format #t "output line 2\nand 3~%") + (system "echo poutine") + (format (current-error-port) + "some error~%")))))) (assert (string-contains output "dummy: running")) (assert (string-contains output "dummy: output line 1")) (assert (string-contains output "dummy: and 3")) @@ -270,7 +271,8 @@ (const #t))) (test-assert "run-job, output with custom format" - (let ((output (parameterize ((%log-format "the message only: ~3@*~a~%")) + (let ((output (parameterize ((%do-logging #t) + (%log-format "the message only: ~3@*~a~%")) (dummy-job/capture-output (lambda () (format #t "output line 1~%")))))) -- cgit v1.2.3