[shepherd] 04/06: herd: Report startup failures in event log.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository shepherd.

commit 265fd8d1eef656dcfbea1c5eb46c7a1031aa299e
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Wed Apr 26 15:22:17 2023 +0200

    herd: Report startup failures in event log.
    
    * modules/shepherd/scripts/herd.scm (display-event-log)[events]: Use
    'fold-right' instead of 'map'.  Detect and flag startup failures.
    Display 'startup-failure' events appropriately.
    * tests/startup-failure.sh: Test it.
---
 modules/shepherd/scripts/herd.scm | 27 +++++++++++++++++++++++----
 tests/startup-failure.sh          |  3 +++
 2 files changed, 26 insertions(+), 4 deletions(-)

diff --git a/modules/shepherd/scripts/herd.scm 
b/modules/shepherd/scripts/herd.scm
index 8c895c0..4d22bff 100644
--- a/modules/shepherd/scripts/herd.scm
+++ b/modules/shepherd/scripts/herd.scm
@@ -254,10 +254,25 @@ into a @code{live-service} record."
   "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)))
+           (fold-right
+            (lambda (pair result)
+              (match pair
+                (('stopped . time)
+                 (cons (if (live-service-one-shot? service)
+                           (list time service 'stopped)
+                           (match result
+                             (((_ _ 'starting) . _)
+                              ;; Transition from "starting" to "stopped"
+                              ;; indicates a startup failure.
+                              (list time service 'startup-failure))
+                             (_
+                              (list time service 'stopped))))
+                       result))
+                ((status . time)
+                 (cons (list time service status)
+                       result))))
+            '()
+            (live-service-status-changes service)))
          services))
 
   (define event>?
@@ -304,6 +319,10 @@ into a @code{live-service} record."
                            (format #t (highlight/warn
                                        (l10n "service ~a is stopped~%"))
                                    name))))
+                   ('startup-failure
+                    (format #t (highlight/error
+                                (l10n "service ~a failed to start~%"))
+                            name))
                    ('starting
                     (format #t (l10n "service ~a is being started~%")
                             name))
diff --git a/tests/startup-failure.sh b/tests/startup-failure.sh
index 27c50a0..a00be20 100644
--- a/tests/startup-failure.sh
+++ b/tests/startup-failure.sh
@@ -50,6 +50,9 @@ $herd status may-fail | grep stopped
 $herd status may-fail | grep "Failed to start"
 $herd status | grep "Failed to start:"
 
+$herd log
+$herd log | grep "service may-fail failed to start"
+
 touch "$stamp"
 $herd start may-fail
 $herd status may-fail | grep running