Package: guix-patches;
Reported by: Ludovic Courtès <ludo <at> gnu.org>
Date: Wed, 11 Jul 2018 21:48:02 UTC
Severity: normal
Tags: patch
Done: ludo <at> gnu.org (Ludovic Courtès)
Bug is archived. No further changes may be made.
Message #11 received at 32128 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 32128 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 2/2] services: mcron: Add 'schedule' action. Date: Wed, 11 Jul 2018 23:55:04 +0200
Inspired by
<https://lists.gnu.org/archive/html/help-guix/2018-07/msg00035.html>.
* gnu/services/mcron.scm (shepherd-schedule-action): New procedure.
(mcron-shepherd-services): Add 'actions' field.
* gnu/tests/base.scm (run-mcron-test)["schedule action"]: New test.
* doc/guix.texi (Scheduled Job Execution): Mention 'herd schedule'.
---
doc/guix.texi | 15 ++++++++++
gnu/services/herd.scm | 3 ++
gnu/services/mcron.scm | 67 +++++++++++++++++++++++++++++++-----------
gnu/tests/base.scm | 7 +++++
4 files changed, 75 insertions(+), 17 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 0a6b2244d..8f72ab2b8 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -10844,6 +10844,21 @@ gexps to introduce job definitions that are passed to mcron
for more information on mcron job specifications. Below is the
reference of the mcron service.
+On a running system, you can use the @code{schedule} action of the service to
+visualize the mcron jobs that will be executed next:
+
+@example
+# herd schedule mcron
+@end example
+
+@noindent
+The example above lists the next five tasks that will be executed, but you can
+also specify the number of tasks to display:
+
+@example
+# herd schedule mcron 10
+@end example
+
@deffn {Scheme Procedure} mcron-service @var{jobs} [#:mcron @var{mcron}]
Return an mcron service running @var{mcron} that schedules @var{jobs}, a
list of gexps denoting mcron job specifications.
diff --git a/gnu/services/herd.scm b/gnu/services/herd.scm
index d882c232c..8c96b7073 100644
--- a/gnu/services/herd.scm
+++ b/gnu/services/herd.scm
@@ -45,6 +45,7 @@
live-service-requirement
live-service-running
+ with-shepherd-action
current-services
unload-services
unload-service
@@ -168,6 +169,8 @@ return #f."
(define-syntax-rule (with-shepherd-action service (action args ...)
result body ...)
+ "Invoke ACTION on SERVICE with the given ARGS, and evaluate BODY with RESULT
+bound to the action's result."
(invoke-action service action (list args ...)
(lambda (result) body ...)))
diff --git a/gnu/services/mcron.scm b/gnu/services/mcron.scm
index 5bee02a58..759d9c8b3 100644
--- a/gnu/services/mcron.scm
+++ b/gnu/services/mcron.scm
@@ -60,29 +60,62 @@
(define (job-file job)
(scheme-file "mcron-job" job))
+(define (shepherd-schedule-action mcron files)
+ "Return a Shepherd action that runs MCRON with '--schedule' for the given
+files."
+ (shepherd-action
+ (name 'schedule)
+ (documentation
+ "Display jobs that are going to be scheduled.")
+ (procedure
+ #~(lambda* (_ #:optional (n "5"))
+ ;; XXX: This is a global side effect.
+ (setenv "GUILE_AUTO_COMPILE" "0")
+
+ ;; Run 'mcron' in a pipe so we can explicitly redirect its output to
+ ;; 'current-output-port', which at this stage is bound to the client
+ ;; connection.
+ (let ((pipe (open-pipe* OPEN_READ
+ #$(file-append mcron "/bin/mcron")
+ (string-append "--schedule=" n)
+ #$@files)))
+ (let loop ()
+ (match (read-line pipe 'concat)
+ ((? eof-object?)
+ (zero? (close-pipe pipe)))
+ (line
+ (display line)
+ (loop)))))))))
+
(define mcron-shepherd-services
(match-lambda
(($ <mcron-configuration> mcron ()) ;nothing to do!
'())
(($ <mcron-configuration> mcron jobs)
- (list (shepherd-service
- (provision '(mcron))
- (requirement '(user-processes))
- (modules `((srfi srfi-1)
- (srfi srfi-26)
- ,@%default-modules))
- (start #~(make-forkexec-constructor
- (list (string-append #$mcron "/bin/mcron")
- #$@(map job-file jobs))
+ (let ((files (map job-file jobs)))
+ (list (shepherd-service
+ (provision '(mcron))
+ (requirement '(user-processes))
+ (modules `((srfi srfi-1)
+ (srfi srfi-26)
+ (ice-9 popen) ;for the 'schedule' action
+ (ice-9 rdelim)
+ (ice-9 match)
+ ,@%default-modules))
+ (start #~(make-forkexec-constructor
+ (list (string-append #$mcron "/bin/mcron") #$@files)
- ;; Disable auto-compilation of the job files and set a
- ;; sane value for 'PATH'.
- #:environment-variables
- (cons* "GUILE_AUTO_COMPILE=0"
- "PATH=/run/current-system/profile/bin"
- (remove (cut string-prefix? "PATH=" <>)
- (environ)))))
- (stop #~(make-kill-destructor)))))))
+ ;; Disable auto-compilation of the job files and set a
+ ;; sane value for 'PATH'.
+ #:environment-variables
+ (cons* "GUILE_AUTO_COMPILE=0"
+ "PATH=/run/current-system/profile/bin"
+ (remove (cut string-prefix? "PATH=" <>)
+ (environ)))))
+ (stop #~(make-kill-destructor))
+
+ (actions
+ (list (shepherd-schedule-action mcron files)))))))))
(define mcron-service-type
(service-type (name 'mcron)
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index 0efb4a6e5..f27064af8 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -632,6 +632,13 @@ non-ASCII names from /tmp.")
(wait-for-file "/root/witness-touch" marionette
#:read '(@ (ice-9 rdelim) read-string)))
+ ;; Make sure the 'schedule' action is accepted.
+ (test-equal "schedule action"
+ '(#t) ;one value, #t
+ (marionette-eval '(with-shepherd-action 'mcron ('schedule) result
+ result)
+ marionette))
+
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
--
2.18.0
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.