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:
parent
a7a456cd6f
commit
e2ecb8045b
3 changed files with 30 additions and 14 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
|
|
@ -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~%"))))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue