[shepherd] 03/04: herd: Display the last process exit status.

[Ludovic Courtès]

civodul pushed a commit to branch devel
in repository shepherd.

commit f62b7796d007327188ff9f5da320be1538397449
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Fri Feb 23 22:02:11 2024 +0100

    herd: Display the last process exit status.
    
    * modules/shepherd/scripts/herd.scm (<live-service>)[exit-statuses]: New
    field.
    (sexp->live-service): Handle it.
    (display-process-exit-status): New procedure.
    (display-service-status): Display exit status.
    * tests/forking-service.sh: Test it.
---
 modules/shepherd/scripts/herd.scm | 36 +++++++++++++++++++++++++++++++++++-
 tests/forking-service.sh          |  3 +++
 2 files changed, 38 insertions(+), 1 deletion(-)

diff --git a/modules/shepherd/scripts/herd.scm 
b/modules/shepherd/scripts/herd.scm
index 3d22d31..cfe89e1 100644
--- a/modules/shepherd/scripts/herd.scm
+++ b/modules/shepherd/scripts/herd.scm
@@ -39,6 +39,7 @@
   (live-service provision requirement one-shot? transient? respawn?
                 enabled? status running
                 status-changes last-respawns startup-failures
+                exit-statuses
                 recent-messages log-file)
   live-service?
   (provision        live-service-provision)       ;list of symbols
@@ -53,6 +54,7 @@
   (status-changes   live-service-status-changes)   ;symbol/integer pairs
   (last-respawns    live-service-last-respawns)    ;list of integers
   (startup-failures live-service-startup-failures) ;list of integers
+  (exit-statuses    live-service-process-exit-statuses) ;integers/timestamps
   (recent-messages  live-service-recent-messages)  ;list of strings
   (log-file         live-service-log-file))        ;#f | string
 
@@ -100,6 +102,7 @@ into a @code{live-service} record."
     (('service ('version 0 _ ...) properties ...)
      (alist-let* properties (provides requires status running respawn? enabled?
                              status-changes last-respawns startup-failures
+                             exit-statuses
                              recent-messages log-file
                              one-shot? transient?)
        (live-service provides requires one-shot?
@@ -111,6 +114,7 @@ into a @code{live-service} record."
                      (or status-changes '())
                      (or last-respawns '())
                      (or startup-failures '())
+                     (or exit-statuses '())
                      (or recent-messages '())
                      log-file)))))
 
@@ -246,6 +250,30 @@ relevant bits quoted according to POSIX shell rules."
               str))
         command)))
 
+(define (display-process-exit-status status)
+  "Display @var{status}, a process status as returned by @code{waitpid}, in a
+human-friendly way."
+  (cond ((zero? status)
+         (format #t (l10n "Process exited successfully.~%")))
+        ((status:exit-val status)
+         =>
+         (lambda (code)
+           (format #t (highlight/error
+                       (l10n "Process exited with code ~a.~%"))
+                   code)))
+        ((status:term-sig status)
+         =>
+         (lambda (signal)
+           (format #t (highlight/error
+                       (l10n "Process terminated with signal ~a.~%"))
+                   signal)))
+        ((status:stop-sig status)
+         =>
+         (lambda (signal)
+           (format #t (highlight/error
+                       (l10n "Process stopped with signal ~a.~%"))
+                   signal)))))
+
 (define* (display-service-status service
                                  #:key
                                  (show-recent-messages? #t)
@@ -328,7 +356,13 @@ relevant bits quoted according to POSIX shell rules."
                         (time->string time)))
                (_
                 (format #t (highlight/warn
-                            (l10n "  It is stopped.~%"))))))))
+                            (l10n "  It is stopped.~%")))))))
+     (match (live-service-process-exit-statuses service)
+       (((status . time) . _)
+        (display "  ")                            ;indent
+        (display-process-exit-status status))
+       (()
+        #f)))
     ('starting
      (let ((highlight (highlight-if-long-transient-status service)))
        (format #t (highlight (l10n "  It is starting.~%")))))
diff --git a/tests/forking-service.sh b/tests/forking-service.sh
index 8aec223..6a529a1 100644
--- a/tests/forking-service.sh
+++ b/tests/forking-service.sh
@@ -182,6 +182,9 @@ kill -0 "$child_pid" && false
 grep ignoring "$log"
 grep SIGKILL "$log"
 $herd status test3 | grep stopped
+$herd status test3 | grep "signal 15"
+$herd status test4 | grep stopped
+$herd status test4 | grep "signal 9"
 
 # Start 'test'.  Make sure 'unload all' terminates it.
 rm -f "$service_pid"