[shepherd] 05/05: service: Serialize <process> records in their entirety.

[Ludovic Courtès]

civodul pushed a commit to branch devel
in repository shepherd.

commit 03e18f1383f9e002ff02d3def76a599e79a46b01
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sun Dec 31 16:22:27 2023 +0100

    service: Serialize <process> records in their entirety.
    
    * modules/shepherd/service.scm (process->sexp): Serialize the whole
    <process> record.
    * modules/shepherd/scripts/herd.scm (shell-quoted-command): New
    procedure.
    (display-service-status): Special-case when ‘live-service-running-value’
    returns a (process …) sexp.
    * tests/close-on-exec.sh, tests/forking-service.sh,
    tests/pid-file.sh, tests/replacement.sh, tests/systemd.sh,
    tests/transient.sh: Adjust grep and sed patterns accordingly.
---
 modules/shepherd/scripts/herd.scm | 35 ++++++++++++++++++++++++++++++-----
 modules/shepherd/service.scm      |  6 ++++--
 tests/close-on-exec.sh            |  4 ++--
 tests/forking-service.sh          |  2 +-
 tests/pid-file.sh                 |  4 ++--
 tests/replacement.sh              |  4 ++--
 tests/systemd.sh                  |  6 +++---
 tests/transient.sh                |  2 +-
 8 files changed, 45 insertions(+), 18 deletions(-)

diff --git a/modules/shepherd/scripts/herd.scm 
b/modules/shepherd/scripts/herd.scm
index f4ebf0f..1c4df1f 100644
--- a/modules/shepherd/scripts/herd.scm
+++ b/modules/shepherd/scripts/herd.scm
@@ -227,6 +227,23 @@ transient status for too long."
   ;; Number of log lines displayed by default.
   10)
 
+(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."
+  (define to-quote
+    (char-set-union (char-set #\\ #\" #\' #\( #\) #\? #\!)
+                    char-set:whitespace))
+
+  (define (needs-quotation? str)
+    (string-any to-quote str))
+
+  (string-join
+   (map (lambda (str)
+          (if (needs-quotation? str)
+              (object->string str)
+              str))
+        command)))
+
 (define* (display-service-status service
                                  #:key
                                  (show-recent-messages? #t)
@@ -252,11 +269,19 @@ transient status for too long."
             (format #t (l10n "  It is started and transient.~%"))
             (format #t (l10n "  It is started.~%")))))
 
-     ;; TRANSLATORS: The "~s" bit is most of the time a placeholder
-     ;; for the PID (an integer) of the running process, and
-     ;; occasionally for another Scheme object.
-     (format #t (l10n "  Running value is ~s.~%")
-             (live-service-running-value service)))
+     (match (live-service-running-value service)
+       (('process ('version 0 _ ...)
+                  ('id pid) ('command command) _ ...)
+        ;; TRANSLATORS: "PID" is short for "process identifier" (Unix jargon).
+        ;; The string here looks like "PID 123 running: /bin/ntpd -x -y".
+        (format #t (l10n "  PID ~a running: ~a~%")
+                (highlight (number->string pid))
+                (shell-quoted-command command)))
+       (_
+        ;; TRANSLATORS: The "~s" bit is most of the time a placeholder for a
+        ;; Scheme value associated with the service.
+        (format #t (l10n "  Running value is ~s.~%")
+                (live-service-running-value service)))))
     ('stopped
      (if (live-service-one-shot? service)
          (format #t (l10n "  It is stopped (one-shot).~%"))
diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 3c515b7..678ca41 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -207,8 +207,10 @@
              (const '()))))
 
 (define-record-type-serializer (process->sexp (process <process>))
-  ;; TODO: Serialize the whole structure so clients can display more info.
-  (process-id process))
+  ;; Serialize all of PROCESS so clients can display more info.
+  `(process (version 0)
+            (id ,(process-id process))
+            (command ,(process-command process))))
 
 ;; Type of service actions.
 (define-record-type <action>
diff --git a/tests/close-on-exec.sh b/tests/close-on-exec.sh
index 47ac9b0..c836d11 100644
--- a/tests/close-on-exec.sh
+++ b/tests/close-on-exec.sh
@@ -154,8 +154,8 @@ test $(cat "$fd_count") -eq 4
 $herd start forkexec-ctor
 $herd status forkexec-ctor
 
-pid="$($herd status forkexec-ctor | grep "Running value" \
-  | sed -e's/^.* \([0-9]\+\)\.$/\1/g')"
+pid="$($herd status forkexec-ctor | grep "PID [0-9]\+ running" \
+  | sed -e's/^.* \([0-9]\+\) running.*$/\1/g')"
 kill -0 "$pid"
 
 ls -l "/proc/$pid/fd"
diff --git a/tests/forking-service.sh b/tests/forking-service.sh
index 8e07359..cb61439 100644
--- a/tests/forking-service.sh
+++ b/tests/forking-service.sh
@@ -156,7 +156,7 @@ done
 # Make sure 'herd stop' eventually terminates processes that ignore SIGTERM.
 $herd start test4
 $herd status test3 | grep running
-child_pid="$($herd status test4 | grep Running | sed '-es/.*Running value is 
\([0-9]\+\)\./\1/g')"
+child_pid="$($herd status test4 | grep PID | sed '-es/.*PID \([0-9]\+\) 
running.*/\1/g')"
 kill -0 "$child_pid"
 $herd stop test3               # this will also stop 'test4'
 kill -0 "$child_pid" && false
diff --git a/tests/pid-file.sh b/tests/pid-file.sh
index 55c02fd..3fff255 100644
--- a/tests/pid-file.sh
+++ b/tests/pid-file.sh
@@ -151,8 +151,8 @@ $herd start test-works
 $herd status test-works | grep running
 test -f "$service_pid"
 kill -0 "`cat $service_pid`"
-known_pid="`$herd status test-works | grep Running \
-   | sed -es'/.*Running value.* \([0-9]\+\)\.$/\1/g'`"
+known_pid="`$herd status test-works | grep PID \
+   | sed -es'/.*PID \([0-9]\+\) running.*$/\1/g'`"
 test `cat $service_pid` -eq $known_pid
 
 $herd stop test-works
diff --git a/tests/replacement.sh b/tests/replacement.sh
index 76bdcd0..1c89e3e 100644
--- a/tests/replacement.sh
+++ b/tests/replacement.sh
@@ -102,8 +102,8 @@ $herd status test | grep disabled
 $herd enable test
 $herd start test
 
-child_pid="$($herd status test | grep Running \
-   | sed '-es/.*Running value is \([0-9]\+\)\./\1/g')"
+child_pid="$($herd status test | grep PID \
+   | sed '-es/.*PID \([0-9]\+\) running.*/\1/g')"
 kill -0 "$child_pid"
 
 $herd stop test
diff --git a/tests/systemd.sh b/tests/systemd.sh
index 42a5af0..19617e6 100644
--- a/tests/systemd.sh
+++ b/tests/systemd.sh
@@ -133,11 +133,11 @@ $herd start test-systemd-unix-eager
 $herd status test-systemd-unix-eager | grep running
 
 # The process should soon be running, before we've tried to connect to it.
-while ! $herd status test-systemd-unix-eager | grep -E "Running value is 
[0-9]+"
+while ! $herd status test-systemd-unix-eager | grep -E "PID [0-9]+ running"
 do $herd status test-systemd-unix-eager; sleep 0.3; done
 
-child_pid="$($herd status test-systemd-unix-eager | grep Running \
-   | sed '-es/.*Running value is \([0-9]\+\)\./\1/g')"
+child_pid="$($herd status test-systemd-unix-eager | grep PID \
+   | sed '-es/.*PID \([0-9]\+\) running.*/\1/g')"
 kill -0 "$child_pid"
 converse_with_echo_server "(make-socket-address AF_UNIX \"$service_socket\")"
 while ! $herd status test-systemd-unix-eager | grep stopped
diff --git a/tests/transient.sh b/tests/transient.sh
index 3f70dac..ff911a6 100644
--- a/tests/transient.sh
+++ b/tests/transient.sh
@@ -59,7 +59,7 @@ $herd status transient-test1 && false
 
 # Terminate the service and make sure it gets unregistered.
 $herd status transient-test2 | grep "transient, running"
-kill $($herd status transient-test2 | grep Running | sed -e's/^.* 
\([0-9]\+\).*$/\1/g')
+kill $($herd status transient-test2 | grep PID | sed -e's/^.* \([0-9]\+\) 
running.*$/\1/g')
 $herd status transient-test2 && false
 
 test $($herd status | grep transient-test | wc -l) -eq 0