[shepherd] 02/05: service: 'eval' action gracefully handles user code returning zero values.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository shepherd.

commit 9b34a1f714cf3602e3c355bfbb50b0c050f4f45a
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Wed Nov 16 17:12:38 2022 +0100

    service: 'eval' action gracefully handles user code returning zero values.
    
    Previously, "herd eval root '(values)'" would cause shepherd to crash.
    
    * modules/shepherd/service.scm (action): Adjust the result of PROC to be
    exactly one value.
    * tests/basic.sh: Test zero-value returns with "herd eval root '(values)'".
---
 modules/shepherd/service.scm | 10 +++++++++-
 tests/basic.sh               |  2 ++
 2 files changed, 11 insertions(+), 1 deletion(-)

diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 77f1078..4d7a61e 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -557,7 +557,15 @@ is not already running, and will return SERVICE's 
canonical name in a list."
     ;; it provides generally useful functionality and information.
     (catch #t
       (lambda ()
-        (apply proc (service-running-value obj) args))
+        ;; PROC may return any number of values (e.g., if PROC is
+        ;; 'eval-in-user-module'), including zero values, but callers expect a
+        ;; single value.  Deal with it gracefully.
+        (call-with-values
+            (lambda ()
+              (apply proc (service-running-value obj) args))
+          (case-lambda
+            (() *unspecified*)
+            ((first . rest) first))))
       (lambda (key . args)
         ;; Special case: 'root' may quit.
         (and (eq? root-service obj)
diff --git a/tests/basic.sh b/tests/basic.sh
index 10bace8..9baeb65 100644
--- a/tests/basic.sh
+++ b/tests/basic.sh
@@ -242,6 +242,8 @@ then false; else true; fi
 if $herd eval root '(no closing paren'
 then false; else true; fi
 
+$herd eval root '(values)'
+
 # Unload everything and make sure only 'root' is left.
 $herd unload root all
 if $herd status | grep "Stopped:"