[shepherd] 01/02: service: One-shot services are started only once by 'start-in-parallel'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository shepherd.

commit f4c48666d41040fef8c1e9ee6c474f45139017a2
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sun Mar 19 21:59:16 2023 +0100

    service: One-shot services are started only once by 'start-in-parallel'.
    
    Previously, since commit c195b87c275f39391c90a75a8843d4f6aedeb9c2, the
    same one-shot service could be started several times if several services
    depend on it.  This change ensures each one-shot service is started only
    once.
    
    * modules/shepherd/service.scm (%one-shot-services-started): New variable.
    (start-in-parallel): Parameterize it.  Call 'lookup-services' on
    elements of SERVICES that are symbols.  When starting a one-shot
    service, call 'start' if and only if it's not already in
    %ONE-SHOT-SERVICES-STARTED.
    * tests/one-shot.sh: Add test.
---
 modules/shepherd/service.scm | 71 +++++++++++++++++++++++++++++---------------
 tests/one-shot.sh            | 35 ++++++++++++++++++++--
 2 files changed, 80 insertions(+), 26 deletions(-)

diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index c5b1899..1c837de 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -612,35 +612,58 @@ channel and wait for its reply."
   (disable-service obj)
   (local-output (l10n "Disabled service ~a.") (canonical-name obj)))
 
+(define %one-shot-services-started
+  ;; Bookkeeping of one-shot services already started.
+  (make-parameter #f))                            ;#f | hash table
+
 (define (start-in-parallel services)
   "Start @var{services} in parallel--i.e., without waiting for each one to be
 started before starting the next one.  Return the subset of @var{services}
 that could not be started."
-  (let ((channel (make-channel)))
-    (for-each (lambda (service)
-                (spawn-fiber
-                 (lambda ()
-                   (let ((value
-                          (guard (c ((action-runtime-error? c)
-                                     (local-output
-                                      (l10n "Exception caught \
+  ;; Use the hash table in %ONE-SHOT-SERVICES-STARTED to keep track of
+  ;; one-shot services that have been started directly or indirectly by this
+  ;; call.  That way, if several services depend on the same one-shot service,
+  ;; its 'start' method is invoked only once.
+  (parameterize ((%one-shot-services-started
+                  (or (%one-shot-services-started)
+                      (make-hash-table))))
+    (let ((services (append-map (lambda (service)
+                                  (if (symbol? service)
+                                      (lookup-services service)
+                                      (list service)))
+                                services))
+          (channel  (make-channel)))
+      (for-each (lambda (service)
+                  (spawn-fiber
+                   (lambda ()
+                     (let ((value
+                            (guard (c ((action-runtime-error? c)
+                                       (local-output
+                                        (l10n "Exception caught \
 while starting ~a: ~s")
-                                      service
-                                      (cons (action-runtime-error-key c)
-                                            (action-runtime-error-arguments 
c)))
-                                     #f))
-                            (start service))))
-                     (put-message channel (cons service value))))))
-              services)
-    (let loop ((i (length services))
-               (failures '()))
-      (if (> i 0)
-          (match (get-message channel)
-            ((service . #f)
-             (loop (- i 1) (cons service failures)))
-            ((_ . _)
-             (loop (- i 1) failures)))
-          failures))))
+                                        service
+                                        (cons (action-runtime-error-key c)
+                                              (action-runtime-error-arguments 
c)))
+                                       #f))
+                              (or (and (one-shot? service)
+                                       (hashq-ref (%one-shot-services-started)
+                                                  service))
+                                  (let ((result (start service)))
+                                    (when (one-shot? service)
+                                      (hashq-set! (%one-shot-services-started)
+                                                  service #t))
+                                    result)))))
+                       (put-message channel (cons service value))))))
+                services)
+      (let loop ((i (length services))
+                 (failures '()))
+        (if (> i 0)
+            (match (get-message channel)
+              ((service . #f)
+               (loop (- i 1) (cons service failures)))
+              ((_ . _)
+               (loop (- i 1) failures)))
+            failures)))))
 
 ;; Start the service, including dependencies.
 (define-method (start (obj <service>) . args)
diff --git a/tests/one-shot.sh b/tests/one-shot.sh
index 3d396e5..c595b38 100644
--- a/tests/one-shot.sh
+++ b/tests/one-shot.sh
@@ -1,5 +1,5 @@
 # GNU Shepherd --- Test one-shot services.
-# Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2019, 2023 Ludovic Courtès <ludo@gnu.org>
 #
 # This file is part of the GNU Shepherd.
 #
@@ -54,7 +54,25 @@ cat > "$conf"<<EOF
              #t)
    #:stop  (lambda _
              (delete-file "$stamp-2")
-             #f)))
+             #f))
+
+ ;; Several services depending on the same one-shot service.
+ (make <service>
+   #:provides '(one-shotty)
+   #:start (const #t)
+   #:one-shot? #t)
+ (make <service>
+   #:provides '(a)
+   #:requires '(one-shotty)
+   #:start (const #t))
+ (make <service>
+   #:provides '(b)
+   #:requires '(a one-shotty)
+   #:start (const #t))
+ (make <service>
+   #:provides '(c)
+   #:requires '(a b one-shotty)
+   #:start (const #t)))
 EOF
 
 rm -f "$pid"
@@ -92,3 +110,16 @@ $herd status test | grep stopped.*one-shot
 $herd status test-2 | grep started
 $herd stop test-2
 if test -f "$stamp-2"; then false; else true; fi
+
+# In the course of starting C, ONE-SHOTTY should be started only once.
+$herd start c
+test $(grep "Starting service one-shotty" "$log" | wc -l) -eq 1
+
+# But we can still start it a second time, indirectly...
+$herd stop a
+$herd start c
+test $(grep "Starting service one-shotty" "$log" | wc -l) -eq 2
+
+# ... and a third time, directly.
+$herd start one-shotty
+test $(grep "Starting service one-shotty" "$log" | wc -l) -eq 3