[shepherd] 06/06: timer: Add optional ‘trigger’ action.

[Ludovic Courtès]

civodul pushed a commit to branch devel
in repository shepherd.

commit 13bb402a612914231d44bf6703bcde4b14252a40
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sun Mar 24 21:57:24 2024 +0100

    timer: Add optional ‘trigger’ action.
    
    * modules/shepherd/service/timer.scm (trigger-timer): New procedure.
    (timer-trigger-action): New variable.
    * tests/services/timer.sh: Add ‘never-timer’ and test it.
    * doc/shepherd.texi (Timers): Document ‘timer-trigger-action’.
    (Service Examples): Add example.
---
 doc/shepherd.texi                  | 21 ++++++++++++++++++++-
 modules/shepherd/service/timer.scm | 15 ++++++++++++++-
 tests/services/timer.sh            | 20 ++++++++++++++++++--
 3 files changed, 52 insertions(+), 4 deletions(-)

diff --git a/doc/shepherd.texi b/doc/shepherd.texi
index 2e340b5..5274fb0 100644
--- a/doc/shepherd.texi
+++ b/doc/shepherd.texi
@@ -1498,6 +1498,21 @@ These arguments are the same as for 
@code{fork+exec-command} and related
 procedures (@pxref{exec-command, @code{fork+exec-command}}).
 @end deffn
 
+Last, it's also possible to add a @code{trigger} action to timer
+services, such that one can trigger it with:
+
+@example
+herd trigger @var{service}
+@end example
+
+To do that, you would add the predefined @code{timer-trigger-action} to
+the service's @code{actions} field (@pxref{Defining Services}).
+
+@defvar timer-trigger-action
+This is the @code{trigger} service action.  When invoked, its effect is
+to invoke the action passed to @code{make-timer-constructor}.
+@end defvar
+
 @c @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 
 @node The root Service
@@ -1758,12 +1773,16 @@ fires everyday at noon and runs the @command{updatedb} 
command as root
               (calendar-event #:hours '(12) #:minutes (0))
               (command '("/usr/bin/updatedb"
                          "--prunepaths=/tmp")))
-    #:stop (make-timer-destructor)))
+    #:stop (make-timer-destructor)
+    #:actions (list timer-trigger-action)))
 
 (register-services (list updatedb))
 (start-in-the-background '(updatedb))
 @end lisp
 
+Thanks to the @code{#:actions} bit above, you can also run @code{herd
+trigger updatedb} to trigger that job.
+
 In these examples, we haven't discussed dependencies among
 services---the @code{#:requires} keyword of @code{<service>}---nor did
 we discuss systemd-style services.  These are extensions of what we've
diff --git a/modules/shepherd/service/timer.scm 
b/modules/shepherd/service/timer.scm
index 539aea3..5eeb3de 100644
--- a/modules/shepherd/service/timer.scm
+++ b/modules/shepherd/service/timer.scm
@@ -51,7 +51,10 @@
             sexp->command
 
             make-timer-constructor
-            make-timer-destructor))
+            make-timer-destructor
+
+            trigger-timer
+            timer-trigger-action))
 
 ;;; Commentary:
 ;;;
@@ -484,3 +487,13 @@ constructor was given by @code{make-timer-destructor}."
       ;; Wait until child processes have terminated.
       (get-message reply))
     #f))
+
+(define (trigger-timer timer)
+  "Trigger the action associated with @var{timer} as if it had reached its
+next calendar event."
+  (local-output (l10n "Triggering timer.~%"))
+  (put-message (timer-channel timer) 'timeout))
+
+(define timer-trigger-action
+  (action 'trigger trigger-timer
+          "Trigger the action associated with this timer."))
diff --git a/tests/services/timer.sh b/tests/services/timer.sh
index 63da5a0..023c111 100644
--- a/tests/services/timer.sh
+++ b/tests/services/timer.sh
@@ -31,7 +31,7 @@ trap "cat $log || true; rm -f $socket $conf $log $service_pid;
       test -f $pid && kill \`cat $pid\` || true; rm -f $pid" EXIT
 
 cat > "$conf" <<EOF
-(use-modules (shepherd service timer))
+(use-modules (shepherd service timer) (srfi srfi-19))
 
 (define endless
   "echo Started endless timer.; echo \$\$ > $PWD/$service_pid; sleep 500")
@@ -52,7 +52,18 @@ cat > "$conf" <<EOF
                           (calendar-event #:seconds (iota 60))
                           (command (quasiquote ("sh" "-c" ,endless)))
                           #:wait-for-termination? #t)
-                 #:stop (make-timer-destructor))))
+                 #:stop (make-timer-destructor))
+        (service '(never-timer)
+                 #:start (make-timer-constructor
+                          (calendar-event
+                            #:months
+                            (if (<= (date-month (current-date)) 6)
+                                '(12)
+                                '(1)))
+                          (command (quote ("sh" "-c" "echo Triggered from 
\$PWD."))
+                                   #:directory "$PWD"))
+                 #:stop (make-timer-destructor)
+                 #:actions (list timer-trigger-action))))
 
 (register-services timers)
 EOF
@@ -87,4 +98,9 @@ $herd stop endless-timer
 kill -0 $(cat "$service_pid") && false
 grep "Process $(cat "$service_pid") of timer 'endless-timer' terminated" "$log"
 
+$herd start never-timer
+grep "Triggered from $PWD" "$log" && false
+$herd trigger never-timer
+until grep "Triggered from $PWD" "$log"; do sleep 0.3; done
+
 $herd stop root