[shepherd] 01/04: herd: Add 'log' command.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository shepherd.

commit 48719446d6f0c644b1f308eefc1dbd1bbbefd7b2
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sun Apr 23 21:43:45 2023 +0200

    herd: Add 'log' command.
    
    * modules/shepherd/scripts/herd.scm (display-event-log): New procedure.
    (run-command): Implement it.
    (main): Recognize "log" as a one-argument command.
    * tests/basic.sh: Test 'herd log'.
    * doc/shepherd.texi (Jump Start): Mention 'herd log'.
---
 doc/shepherd.texi                 |  7 +++++
 modules/shepherd/scripts/herd.scm | 58 +++++++++++++++++++++++++++++++++++++--
 tests/basic.sh                    |  4 +++
 3 files changed, 67 insertions(+), 2 deletions(-)

diff --git a/doc/shepherd.texi b/doc/shepherd.texi
index fe3441e..9a7fe5a 100644
--- a/doc/shepherd.texi
+++ b/doc/shepherd.texi
@@ -201,6 +201,13 @@ services as started.  If you just want to know the status 
of the
 herd status apache
 @end example
 
+You may also view a log of service events, including the time at which
+each service was started or stopped, by running:
+
+@example
+herd log
+@end example
+
 @cindex Stopping a service
 You can stop
 a service and all the services that depend on it will be stopped.
diff --git a/modules/shepherd/scripts/herd.scm 
b/modules/shepherd/scripts/herd.scm
index 551ada0..98407ac 100644
--- a/modules/shepherd/scripts/herd.scm
+++ b/modules/shepherd/scripts/herd.scm
@@ -250,6 +250,56 @@ into a @code{live-service} record."
                (time->string time)))
       (_ #t))))
 
+(define (display-event-log services)
+  "Display status changes of @var{services} as a chronologically-sorted log."
+  (define events
+    (map (lambda (service)
+           (map (match-lambda
+                  ((status . time)
+                   (list time service status)))
+                (live-service-status-changes service)))
+         services))
+
+  (define event>?
+    (match-lambda*
+      (((time1 . _) (time2 . _))
+       (> time1 time2))))
+
+  (define sorted
+    ;; Each event list is already sorted, so merge them.  (They cannot be
+    ;; resorted based on timestamps because there may be several events with
+    ;; the same timestamps so resorting would lose causal ordering.)
+    (reduce (lambda (events1 events2)
+              (merge events1 events2 event>?))
+            '()
+            events))
+
+  (for-each (match-lambda
+              ((time service status)
+               (let ((name (live-service-canonical-name service)))
+                 (format #t "~a\t"
+                         (date->string
+                          (time-utc->date
+                           (make-time time-utc 0 time))
+                          "~e ~b ~Y ~H:~M:~S"))
+                 (match status
+                   ('running
+                    (format #t (highlight (l10n "service ~a is running~%"))
+                            name))
+                   ('stopped
+                    (format #t (highlight/warn (l10n "service ~a is 
stopped~%"))
+                            name))
+                   ('starting
+                    (format #t (l10n "service ~a is being started~%")
+                            name))
+                   ('stopping
+                    (format #t (l10n "service ~a is being stopped~%")
+                            name))
+                   (_
+                    (format #t (l10n "service ~a is entering state '~a'~%")
+                            name status))))))
+            (reverse sorted)))
+
 (define root-service?
   ;; XXX: This procedure is written in a surprising way to work around a
   ;; compilation bug in Guile 3.0.5 to 3.0.7: <https://bugs.gnu.org/47172>.
@@ -262,7 +312,7 @@ into a @code{live-service} record."
 the daemon via SOCKET-FILE."
   (with-system-error-handling
    (let ((sock    (open-connection socket-file))
-         (action* (if (and (eq? action 'detailed-status)
+         (action* (if (and (memq action '(detailed-status log))
                            (root-service? service))
                       'status
                       action)))
@@ -288,6 +338,9 @@ the daemon via SOCKET-FILE."
           (('detailed-status (or 'root 'shepherd))
            (display-detailed-status
             (map sexp->live-service (first result))))
+          (('log (or 'root 'shepherd))
+           (display-event-log
+            (map sexp->live-service (first result))))
           (('help (or 'root 'shepherd))
            (match result
              ((help-text)
@@ -355,7 +408,8 @@ SERVICE with the ARGs.")
                                  (set! socket-file file))))
 
       (match (reverse command-args)
-        (((and action (or "status" "detailed-status" "help"))) ;one argument
+        (((and action
+               (or "status" "detailed-status" "help" "log"))) ;one argument
          (run-command socket-file (string->symbol action) 'root '()))
         ((action service args ...)
          (run-command socket-file
diff --git a/tests/basic.sh b/tests/basic.sh
index 348e121..7a0d40a 100644
--- a/tests/basic.sh
+++ b/tests/basic.sh
@@ -94,6 +94,10 @@ $herd status test | grep running
 $herd stop test
 ! test -f "$stamp"
 
+$herd log
+$herd log | grep "service test is running"
+$herd log | grep "service test is stopped"
+
 $herd status test | grep stopped
 
 # Stopping a stopped service should be a no-op.