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 --- tests/base.scm | 106 +++++++++++++++++++++++++++++++++++++++++++++++++-------- tests/basic.sh | 13 +++++++ 2 files changed, 105 insertions(+), 14 deletions(-) (limited to 'tests') diff --git a/tests/base.scm b/tests/base.scm index eb9e11a..914b4c6 100644 --- a/tests/base.scm +++ b/tests/base.scm @@ -1,5 +1,6 @@ ;;;; base.scm -- tests for (mcron base) module ;;; Copyright © 2018 Mathieu Lirzin +;;; Copyright © 2021 Maxim Cournoyer ;;; ;;; This file is part of GNU Mcron. ;;; @@ -16,7 +17,8 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Mcron. If not, see . -(use-modules (srfi srfi-64) +(use-modules ((rnrs base) #:select (assert)) + (srfi srfi-64) (srfi srfi-111) (mcron base)) @@ -40,7 +42,7 @@ #:key (user (getpw)) (time-proc 1+) - (action (λ () "dummy action")) + (action (lambda () "dummy action")) (environment '()) (next-time 0)) (make-job user time-proc action environment displayable next-time)) @@ -191,25 +193,101 @@ ;;; Check 'run-job' and 'child-cleanup'. ;;; XXX: Having to use the filesystem for a unit test is wrong. (let* ((filename (tmpnam)) - (action (λ () (close-port (open-output-file filename)))) + (action (lambda () (close-port (open-output-file filename)))) (job (make-dummy-job #:user (getpw (getuid)) #:action action))) (dynamic-wind (const #t) - (λ () + (lambda () (sigaction SIGCHLD (const #t)) - (run-job job) - ;; Wait for the SIGCHLD signal sent when job exits. - (pause) - ;; Check 'run-job' result and if the number of children is up-to-date. - (test-equal "run-job: basic" - 1 - (and (access? filename F_OK) - (unbox number-children))) - (child-cleanup) + (let ((child-data (run-job job))) + ;; Wait for the SIGCHLD signal sent when job exits. + (pause) + ;; Check 'run-job' result and if the number of children is up-to-date. + (test-equal "run-job: basic" + 1 + (and (access? filename F_OK) + (unbox number-children))) + (child-cleanup (list child-data))) ;; Check that 'child-cleanup' updates the number of children. (test-equal "child-cleanup: one" 0 (unbox number-children))) - (λ () + (lambda () (and (access? filename F_OK) (delete-file filename)) (sigaction SIGCHLD SIG_DFL)))) +(define (dummy-job/capture-output action) + "Return the output of a dummy-job that ran ACTION." + (with-output-to-string + (lambda () + (dynamic-wind + (const #t) + (lambda () + (sigaction SIGCHLD (const #t)) + (let ((child-data + (run-job + (make-dummy-job + #:user (getpw (getuid)) + #:action action)))) + (pause) + (child-cleanup (list child-data)))) + (lambda () + #t + (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~%"))))) + (assert (string-contains output "dummy: running")) + (assert (string-contains output "dummy: output line 1")) + (assert (string-contains output "dummy: and 3")) + (assert (string-contains output "dummy: poutine")) + (assert (string-contains output "dummy: some error")) + (assert (string-contains output "dummy: completed in")))) + +(test-assert "validate-date-format, valid" + (validate-date-format "~1")) + +(test-assert "validate-date-format, invalid" + (catch 'mcron-error + (lambda () + (validate-date-format "~¾") + #f) + (const #t))) + +(test-assert "validate-log-format, valid" + (validate-log-format "the message only: ~3@*~a~%")) + +(test-assert "validate-log-format, invalid" + (catch 'mcron-error + (lambda () + ;; There aren't that many arguments! + (validate-log-format "~20@*~a~%") + #f) + (const #t))) + +(test-assert "run-job, output with custom format" + (let ((output (parameterize ((%log-format "the message only: ~3@*~a~%")) + (dummy-job/capture-output + (lambda () + (format #t "output line 1~%")))))) + (string-contains output "the message only: output line 1\n"))) + +(test-assert "run-job, failure" + (let ((output (dummy-job/capture-output + (lambda () + (error "that didn't go well"))))) + (assert (string-contains output "that didn't go well")) + (assert (string-contains output "failed after")))) + +(test-assert "run-job, failure in shell action" + (let ((output (dummy-job/capture-output + (lambda () + (system "exit 1"))))) + (assert (string-contains output "unclean exit status")) + (assert (string-contains output "failed after")))) + (test-end) diff --git a/tests/basic.sh b/tests/basic.sh index 7b2ca55..79b2032 100644 --- a/tests/basic.sh +++ b/tests/basic.sh @@ -1,5 +1,6 @@ # basic.sh -- basic tests for mcron # Copyright © 2017 Mathieu Lirzin +# Copyright © 2021 Maxim Cournoyer # # This file is part of GNU Mcron. # @@ -33,4 +34,16 @@ grep -e "foo" "output$$" || fail_ "'foo.guile' job is not scheduled" mcron --schedule=1 > "output$$" grep -e "foo" "output$$" || fail_ "'foo.guile' job is not scheduled" +mcron --date-format="~½" cron/foo.guile \ + && fail_ "mcron --date-format unexpected pass" + +mcron --log-format="~½" cron/foo.guile \ + && fail_ "mcron --log-format unexpected pass" + +cron --date-format="~½" cron/foo.guile \ + && fail_ "cron --date-format unexpected pass" + +cron --log-format="~½" cron/foo.guile \ + && fail_ "cron --log-format unexpected pass" + Exit 0 -- cgit v1.2.3