[shepherd] 06/06: herd: Display information about timers.

[Ludovic Courtès]

civodul pushed a commit to branch wip-timers
in repository shepherd.

commit 57786b0cb844367ecb441234f213d8e9dc245fa8
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Wed Mar 20 23:08:31 2024 +0100

    herd: Display information about timers.
    
    * modules/shepherd/scripts/herd.scm (%default-timer-history-size): New
    variable.
    (display-service-status): Add #:timer-history-size.  Add clause
    for (timer …) values.  Show recent exit values for timers.
    * tests/services/timer.sh: Test it.
---
 modules/shepherd/scripts/herd.scm | 35 ++++++++++++++++++++++++++++++++++-
 tests/services/timer.sh           |  1 +
 2 files changed, 35 insertions(+), 1 deletion(-)

diff --git a/modules/shepherd/scripts/herd.scm 
b/modules/shepherd/scripts/herd.scm
index cfe89e1..04cf600 100644
--- a/modules/shepherd/scripts/herd.scm
+++ b/modules/shepherd/scripts/herd.scm
@@ -233,6 +233,10 @@ transient status for too long."
   ;; Number of log lines displayed by default.
   10)
 
+(define %default-timer-history-size
+  ;; Number of timer exit statuses showed by default.
+  5)
+
 (define (shell-quoted-command command)
   "Return a string corresponding to @var{command}, a list of strings, with the
 relevant bits quoted according to POSIX shell rules."
@@ -277,7 +281,9 @@ human-friendly way."
 (define* (display-service-status service
                                  #:key
                                  (show-recent-messages? #t)
-                                 (log-history-size %default-log-history-size))
+                                 (log-history-size %default-log-history-size)
+                                 (timer-history-size
+                                  %default-timer-history-size))
   "Display the status of @var{service}, an sexp.  When
 @var{show-recent-messages?} is true, display messages recently logged by
 @var{service}."
@@ -338,6 +344,16 @@ human-friendly way."
                     (format #t "    - ~a (~s)~%"
                             (socket-address->string address) name))
                   names addresses))
+       (('timer ('version 0)
+                ('event event) ('action action))
+        (format #t (l10n "  Timed service.~%"))
+        (match action
+          (('command ('version 0) ('arguments command) _ ...)
+           (format #t (l10n "  Periodically running: ~a.~%")
+                   (shell-quoted-command command)))
+          ('procedure
+           (format #t (l10n "  Periodically running Scheme code.~%")))
+          (_ #f)))
        (_
         ;; TRANSLATORS: The "~s" bit is most of the time a placeholder for a
         ;; Scheme value associated with the service.
@@ -399,6 +415,23 @@ human-friendly way."
             (live-service-log-file service)))
 
   (when show-recent-messages?
+    (match (live-service-running-value service)
+      (('timer . _)
+       (match (live-service-process-exit-statuses service)
+         (()
+          #t)
+         (statuses
+          (newline)
+          (format #t (highlight (l10n "Recent runs:~%")))
+          (for-each (match-lambda
+                      ((status . time)
+                       (format #t "  ~a"
+                               (strftime default-logfile-date-format
+                                         (localtime time)))
+                       (display-process-exit-status status)))
+                    (reverse (at-most timer-history-size statuses))))))
+      (_ #f))
+
     (match (live-service-recent-messages service)
       (() #t)
       (messages
diff --git a/tests/services/timer.sh b/tests/services/timer.sh
index 7fac11c..a67347a 100644
--- a/tests/services/timer.sh
+++ b/tests/services/timer.sh
@@ -69,6 +69,7 @@ $herd start timer-with-command
 sleep 2
 grep "Hi from " "$log"
 $herd status timer-with-command | grep "Hi from " # recent messages
+$herd status timer-with-command | grep "exited successfully" # recent runs
 $herd stop timer-with-command
 
 $herd start timer-with-procedure