[shepherd] 05/06: herd: Distinguish ‘herd status root’ from ‘herd status’.

[Ludovic Courtès]

civodul pushed a commit to branch devel
in repository shepherd.

commit 66e2eae19a23b177c58429f046ad3b192b0c6f7e
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sun Jun 16 00:02:33 2024 +0200

    herd: Distinguish ‘herd status root’ from ‘herd status’.
    
    ‘herd status’ used to be synonymous with ‘herd status root’.  Now the
    latter shows information about ‘root’ itself, in particular its recent
    messages.
    
    * modules/shepherd/scripts/herd.scm (run-command): Accept SERVICE as #f.
    Add special treatment for ‘status’ when SERVICE is 'root or 'shepherd.
    (main): Pass #f as the service to ‘run-command’ when it’s omitted from
    the command line.
    * tests/basic.sh: Adjust accordingly.
    * doc/shepherd.texi (Jump Start): Document it.
---
 doc/shepherd.texi                 |  7 +++++
 modules/shepherd/scripts/herd.scm | 58 ++++++++++++++++++++++++---------------
 tests/basic.sh                    | 11 ++++++--
 3 files changed, 51 insertions(+), 25 deletions(-)

diff --git a/doc/shepherd.texi b/doc/shepherd.texi
index 2a59899..84b895b 100644
--- a/doc/shepherd.texi
+++ b/doc/shepherd.texi
@@ -202,6 +202,13 @@ each service was started or stopped, by running:
 herd log
 @end example
 
+Likewise, you can read messages recently logged by @command{shepherd}
+itself by querying the @dfn{root service} (@pxref{The root Service}):
+
+@example
+herd status root
+@end example
+
 Services and their dependencies form a @dfn{graph}, which you can view,
 for instance with the help of
 @uref{https://github.com/jrfonseca/xdot.py, xdot}, by running:
diff --git a/modules/shepherd/scripts/herd.scm 
b/modules/shepherd/scripts/herd.scm
index b750c63..f9fbf58 100644
--- a/modules/shepherd/scripts/herd.scm
+++ b/modules/shepherd/scripts/herd.scm
@@ -737,16 +737,20 @@ fontcolor = ~a, style = ~a];~%"
                       #:key
                       (log-history-size %default-log-history-size)
                       (timer-history-size %default-timer-history-size))
-  "Perform ACTION with ARGS on SERVICE, and display the result.  Connect to
-the daemon via SOCKET-FILE."
+  "Perform @var{action} with @var{args} on @var{service}, and display the
+result.  If @var{service} is @code{#f}, perform @var{action} on the root
+service but display a generic overview rather than information about
+@code{root} itself.  Connect to the daemon via @var{socket-file}."
   (with-system-error-handling
    (let ((sock    (open-connection socket-file))
          (action* (if (and (memq action '(detailed-status log graph))
-                           (root-service? service))
+                           (or (not service)
+                               (root-service? service)))
                       'status
                       action)))
      ;; Send the command.
-     (write-command (shepherd-command action* service #:arguments args)
+     (write-command (shepherd-command action* (or service 'root)
+                                      #:arguments args)
                     sock)
 
      ;; Receive output.  Interpret the command's output when possible and
@@ -761,19 +765,19 @@ the daemon via SOCKET-FILE."
 
         ;; Then interpret the result
         (match (list action service)
-          (('status (or 'root 'shepherd))
+          (('status #f)
            (display-status-summary
             (map sexp->live-service (first result))))
-          (('detailed-status (or 'root 'shepherd))
+          (('detailed-status #f)
            (display-detailed-status
             (map sexp->live-service (first result))))
-          (('log (or 'root 'shepherd))
+          (('log (or 'root 'shepherd #f))
            (display-event-log
             (map sexp->live-service (first result))))
-          (('graph (or 'root 'shepherd))
+          (('graph (or 'root 'shepherd #f))
            (display-service-graph
             (map sexp->live-service (first result))))
-          (('help (or 'root 'shepherd))
+          (('help (or 'root 'shepherd #f))
            (match result
              ((help-text)
               (display (gettext help-text))
@@ -784,18 +788,28 @@ the daemon via SOCKET-FILE."
               (write value)
               (newline))))
           (('status _)
-           ;; We get a list of statuses, in case several services have the
-           ;; same name.  FIXME: These days each name maps to exactly one
-           ;; service so RESULT is always a singleton.
-           (for-each (lambda (sexp)
-                       (let ((service (sexp->live-service sexp)))
-                         (display-service-status service
-                                                 #:show-recent-messages? #t
-                                                 #:log-history-size
-                                                 log-history-size
-                                                 #:timer-history-size
-                                                 timer-history-size)))
-                     result))
+           ;; RESULT is enclosed in a list (a singleton) because it used to be
+           ;; that one name could map to several services.
+           (let* ((result (first result))
+                  (service (match service
+                             ((or 'root 'shepherd)
+                              ;; The 'status' action of 'root' returns the
+                              ;; entire list of services.  Extract 'root'.
+                              (any (lambda (sexp)
+                                     (let ((service (sexp->live-service sexp)))
+                                       (and (memq 'root
+                                                  (live-service-provision
+                                                   service))
+                                            service)))
+                                   result))
+                             (_
+                              (sexp->live-service result)))))
+             (display-service-status service
+                                     #:show-recent-messages? #t
+                                     #:log-history-size
+                                     log-history-size
+                                     #:timer-history-size
+                                     timer-history-size)))
           (('start _)
            (unless result
              (report-error (l10n "failed to start service ~a")
@@ -880,7 +894,7 @@ a positive integer")
       (match (reverse command-args)
         (((and action
                (or "status" "detailed-status" "help" "log" "graph"))) ;one 
argument
-         (run-command socket-file (string->symbol action) 'root '()
+         (run-command socket-file (string->symbol action) #f '()
                       #:log-history-size log-history-size))
         ((action service args ...)
          (run-command socket-file
diff --git a/tests/basic.sh b/tests/basic.sh
index 7e59f94..f3d4b44 100644
--- a/tests/basic.sh
+++ b/tests/basic.sh
@@ -84,15 +84,20 @@ shepherd_pid="`cat $pid`"
 
 kill -0 $shepherd_pid
 test -S "$socket"
-pristine_status=`$herd status root` # Prep for 'reload' test.
+pristine_status=`$herd status -n 0` # Prep for 'reload' test.
 echo $pristine_status | grep -E '(Start.*root|Stop.*test)'
 
+# The "Recent messages" bit should contain that phrase.
+$herd status root | grep "Service root started"
+
 $herd graph | grep '"test-2" -> "test"'
 
 $herd start test
 test -f "$stamp"
 $herd status test | grep running
 
+$herd status root | grep "Service test started" # from "Recent messages"
+
 $herd stop test
 test -f "$stamp" && false
 
@@ -182,10 +187,10 @@ then false; else true; fi
 # Unload two services, make sure the other it still around.
 $herd unload root broken
 $herd unload root test
-$herd status | grep -e "- test-2"
+$herd status -n 0 | grep -e "- test-2"
 
 $herd reload root "$conf"
-test "`$herd status`" == "$pristine_status"
+test "`$herd status -n 0`" == "$pristine_status"
 
 # Dynamically loading code.