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
This commit is contained in:
Dale Mellor 2022-07-07 16:51:31 +01:00
commit e2ecb8045b
Signed by: khleedril
GPG key ID: CA471FD501618A49
3 changed files with 30 additions and 14 deletions

View file

@ -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 <job>
(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 <job-data> 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 <job-data> 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

View file

@ -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))))

View file

@ -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~%"))))))