[shepherd] branch master updated: service: Remove 'call-with-blocked-asyncs' from 'stop' method.

[Ludovic Courtès]

This is an automated email from the git hooks/post-receive script.

civodul pushed a commit to branch master
in repository shepherd.

The following commit(s) were added to refs/heads/master by this push:
     new 5b08dca  service: Remove 'call-with-blocked-asyncs' from 'stop' method.
5b08dca is described below

commit 5b08dcab1275e4b88fa0fba00aafb980c6ab4af7
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sun Nov 13 23:42:17 2022 +0100

    service: Remove 'call-with-blocked-asyncs' from 'stop' method.
    
    * modules/shepherd/service.scm (stop): Remove
    'call-with-blocked-asyncs'.  This would introduce a continuation
    barrier, making it impossible to use 'system*' (for example) from
    'stop'; it had also become unnecessary.
    * tests/system-star.sh: Use 'system*' in 'stop' and make sure it
    actually works.
---
 modules/shepherd/service.scm | 118 +++++++++++++++++++++----------------------
 tests/system-star.sh         |   2 +
 2 files changed, 60 insertions(+), 60 deletions(-)

diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 441966f..afb41bf 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -456,66 +456,64 @@ NEW-SERVICE."
 canonical names for all of the services which have been stopped (including
 transitive dependent services).  This method will print a warning if SERVICE
 is not already running, and will return SERVICE's canonical name in a list."
-  ;; Block asyncs so the SIGCHLD handler doesn't execute concurrently.
-  ;; Notably, that makes sure the handler processes the SIGCHLD for SERVICE's
-  ;; process once we're done; otherwise, it could end up respawning SERVICE.
-  (call-with-blocked-asyncs
-   (lambda ()
-     (if (not (running? service))
-         (begin
-           (local-output (l10n "Service ~a is not running.")
-                         (canonical-name service))
-           (list (canonical-name service)))
-         (if (slot-ref service 'stop-delay?)
-             (begin
-               (slot-set! service 'waiting-for-termination? #t)
-               (local-output (l10n "Service ~a pending to be stopped.")
-                             (canonical-name service))
-               (list (canonical-name service)))
-             (let ((name (canonical-name service))
-                   (stopped-dependents (fold-services (lambda (other acc)
-                                                        (if (and (running? 
other)
-                                                                 (required-by? 
service other))
-                                                            (append (stop 
other) acc)
-                                                            acc))
-                                                      '())))
-               ;; Stop the service itself.
-               (catch #t
-                 (lambda ()
-                   (apply (slot-ref service 'stop)
-                          (service-running-value service)
-                          args))
-                 (lambda (key . args)
-                   ;; Special case: 'root' may quit.
-                   (and (eq? root-service service)
-                        (eq? key 'quit)
-                        (apply quit args))
-                   (caught-error key args)))
-
-               ;; SERVICE is no longer running.
-               (slot-set! service 'running #f)
-
-               ;; Reset the list of respawns.
-               (slot-set! service 'last-respawns '())
-
-               ;; Replace the service with its replacement, if it has one
-               (let ((replacement (slot-ref service 'replacement)))
-                 (when replacement
-                   (replace-service service replacement)))
-
-               ;; Status message.
-               (if (running? service)
-                   (local-output (l10n "Service ~a could not be stopped.")
-                                 name)
-                   (local-output (l10n "Service ~a has been stopped.")
-                                 name))
-
-               (when (transient? service)
-                 (hashq-remove! %services (canonical-name service))
-                 (local-output (l10n "Transient service ~a unregistered.")
-                               (canonical-name service)))
-
-               (cons name stopped-dependents)))))))
+  ;; Note: SIGCHLD resulting from calling SERVICE's 'stop' method won't be
+  ;; handled by the time we're done (in which case we'd end up respawning the
+  ;; service we're trying to stop), unless we explicitly yield.
+  (if (not (running? service))
+      (begin
+        (local-output (l10n "Service ~a is not running.")
+                      (canonical-name service))
+        (list (canonical-name service)))
+      (if (slot-ref service 'stop-delay?)
+          (begin
+            (slot-set! service 'waiting-for-termination? #t)
+            (local-output (l10n "Service ~a pending to be stopped.")
+                          (canonical-name service))
+            (list (canonical-name service)))
+          (let ((name (canonical-name service))
+                (stopped-dependents (fold-services (lambda (other acc)
+                                                     (if (and (running? other)
+                                                              (required-by? 
service other))
+                                                         (append (stop other) 
acc)
+                                                         acc))
+                                                   '())))
+            ;; Stop the service itself.
+            (catch #t
+              (lambda ()
+                (apply (slot-ref service 'stop)
+                       (service-running-value service)
+                       args))
+              (lambda (key . args)
+                ;; Special case: 'root' may quit.
+                (and (eq? root-service service)
+                     (eq? key 'quit)
+                     (apply quit args))
+                (caught-error key args)))
+
+            ;; SERVICE is no longer running.
+            (slot-set! service 'running #f)
+
+            ;; Reset the list of respawns.
+            (slot-set! service 'last-respawns '())
+
+            ;; Replace the service with its replacement, if it has one
+            (let ((replacement (slot-ref service 'replacement)))
+              (when replacement
+                (replace-service service replacement)))
+
+            ;; Status message.
+            (if (running? service)
+                (local-output (l10n "Service ~a could not be stopped.")
+                              name)
+                (local-output (l10n "Service ~a has been stopped.")
+                              name))
+
+            (when (transient? service)
+              (hashq-remove! %services (canonical-name service))
+              (local-output (l10n "Transient service ~a unregistered.")
+                            (canonical-name service)))
+
+            (cons name stopped-dependents)))))
 
 ;; Call action THE-ACTION with ARGS.
 (define-method (action (obj <service>) the-action . args)
diff --git a/tests/system-star.sh b/tests/system-star.sh
index c3bb17a..0af3c64 100755
--- a/tests/system-star.sh
+++ b/tests/system-star.sh
@@ -41,6 +41,7 @@ cat > "$conf" <<EOF
                    (status:exit-val
                     (system* "$SHELL" "-c" "$script"))))
    #:stop  (lambda _
+             (system* "$SHELL" "-c" "echo STOPPING")
              (delete-file "$stamp"))
    #:respawn? #f))
 EOF
@@ -81,5 +82,6 @@ $herd status test | grep "exit-code 123"
 
 $herd stop test
 ! test -f "$stamp"
+grep "STOPPING" "$log"
 
 $herd stop root