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

[Ludovic Courtès]

civodul pushed a commit to branch devel
in repository shepherd.

commit d0ee908d04f61dd65bcbd6d2295913e632e4af47
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.
    * modules/shepherd/service/timer.scm (sexp->command): New procedure.
    * tests/services/timer.sh: Test it.
---
 modules/shepherd/scripts/herd.scm  | 50 +++++++++++++++++++++++++++++++++++++-
 modules/shepherd/service/timer.scm | 18 ++++++++++++++
 tests/services/timer.sh            |  2 ++
 3 files changed, 69 insertions(+), 1 deletion(-)

diff --git a/modules/shepherd/scripts/herd.scm 
b/modules/shepherd/scripts/herd.scm
index cfe89e1..9c6b768 100644
--- a/modules/shepherd/scripts/herd.scm
+++ b/modules/shepherd/scripts/herd.scm
@@ -23,6 +23,11 @@
   #:use-module (shepherd args)
   #:use-module (shepherd comm)
   #:use-module (shepherd colors)
+  #:autoload   (shepherd service timer) (sexp->command
+                                         command?
+                                         command-arguments
+                                         command-user)
+  #:use-module (ice-9 format)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 match)
   #:autoload   (ice-9 vlist) (vlist-null vhash-consq vhash-assq)
@@ -233,6 +238,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 +286,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 +349,26 @@ human-friendly way."
                     (format #t "    - ~a (~s)~%"
                             (socket-address->string address) name))
                   names addresses))
+       (('timer ('version 0)
+                ('event event) ('action action)
+                ('processes processes) _ ...)
+        (format #t (l10n "  Timed service.~%"))
+        (match (or (sexp->command action) action)
+          ((? command? command)
+           (if (command-user command)
+               (format #t (l10n "  Periodically running as ~s: ~a.~%")
+                       (command-user command)
+                       (shell-quoted-command (command-arguments command)))
+               (format #t (l10n "  Periodically running: ~a.~%")
+                       (shell-quoted-command (command-arguments command))))
+           (when (pair? processes)
+             (format #t (l10n "  Child process:~{ ~a~}~%"
+                              "  Child processes:~{ ~a~}~%"
+                              (length processes))
+                     processes)))
+          ('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 +430,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/modules/shepherd/service/timer.scm 
b/modules/shepherd/service/timer.scm
index 8b0d52d..45627dd 100644
--- a/modules/shepherd/service/timer.scm
+++ b/modules/shepherd/service/timer.scm
@@ -47,6 +47,7 @@
             command-directory
             command-resource-limits
             command-environment-variables
+            sexp->command
 
             make-timer-constructor
             make-timer-destructor))
@@ -335,6 +336,23 @@ list, to be executed as @var{user} and @var{group}, with 
the given
             (directory ,(command-directory command))
             (resource-limits ,(command-resource-limits command))))
 
+(define (sexp->command sexp)
+  "Deserialize @var{sexp} into a command and return it.  Return #f if
+@var{sexp} was not recognized."
+  (match sexp
+    (('command ('version 0)
+               ('arguments arguments)
+               ('user user) ('group group)
+               ('environment-variables environment-variables)
+               ('directory directory)
+               ('resource-limits resource-limits)
+               _ ...)
+     (command arguments #:user user #:group group
+              #:environment-variables environment-variables
+              #:directory directory
+              #:resource-limits resource-limits))
+    (_ #f)))
+
 (define-record-type-serializer (serializer-timer (timer <timer>))
   ;; Serialize TIMER to clients can inspect it.
   `(timer (version 0)
diff --git a/tests/services/timer.sh b/tests/services/timer.sh
index da10a86..63da5a0 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
@@ -81,6 +82,7 @@ sleep 2
 grep "Started endless timer" "$log"
 $herd status endless-timer | grep "Started endless timer" # recent messages
 kill -0 $(cat "$service_pid")
+$herd status endless-timer | grep "Child process: $(cat "$service_pid")"
 $herd stop endless-timer
 kill -0 $(cat "$service_pid") && false
 grep "Process $(cat "$service_pid") of timer 'endless-timer' terminated" "$log"