[shepherd] 06/08: service: Terminate controlling fiber of unregistered services.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository shepherd.

commit c726650645372007b1afadc0520202e6801953c6
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sat Mar 18 19:05:49 2023 +0100

    service: Terminate controlling fiber of unregistered services.
    
    Previously, when replacing or unloading a service, its service fiber
    would be kept and left running (idle, though).
    
    * modules/shepherd/service.scm (service-controller): Handle 'terminate
    message.
    (stop): Move replacement handling at the very end.
    (service-registry)[unregister]: Send 'terminate message to each one of
    SERVICES.
---
 modules/shepherd/service.scm | 29 +++++++++++++++++++++++------
 1 file changed, 23 insertions(+), 6 deletions(-)

diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 32a4201..fe8b6b6 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -457,6 +457,19 @@ Log abnormal termination reported by @var{status}."
              (loop status value condition enabled? respawns))
            (begin
              (put-message reply #f)
+             (loop status value condition enabled? respawns))))
+
+      ('terminate                                 ;no reply
+       (if (eq? status 'stopped)
+           (begin
+             ;; Exit the loop, terminating this fiber.
+             (slot-set! service 'control #f)
+             #t)
+           (begin
+             ;; Oops, that shouldn't happen!
+             (local-output
+              (l10n "Attempt to terminate controller of ~a in ~a state!")
+              (canonical-name service) status)
              (loop status value condition enabled? respawns)))))))
 
 (define (service? obj)
@@ -751,11 +764,6 @@ is not already running, and will return SERVICE's 
canonical name in a list."
         (put-message (service-control service)
                      'notify-termination)
 
-        ;; 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.")
@@ -769,6 +777,11 @@ is not already running, and will return SERVICE's 
canonical name in a list."
           (local-output (l10n "Transient service ~a unregistered.")
                         (canonical-name service)))
 
+        ;; Replace the service with its replacement, if it has one.
+        (let ((replacement (slot-ref service 'replacement)))
+          (when replacement
+            (replace-service service replacement)))
+
         (cons name stopped-dependents))))
 
 ;; Call action THE-ACTION with ARGS.
@@ -929,7 +942,11 @@ clients."
 requests arriving on @var{channel}."
   (let loop ((registered vlist-null))
     (define (unregister services)
-      ;; Return REGISTERED minus SERVICES.
+      ;; Terminate the controller of each of SERVICES and return REGISTERED
+      ;; minus SERVICES.
+      (for-each (lambda (service)
+                  (put-message (service-control service) 'terminate))
+                services)
       (vhash-fold (lambda (name service result)
                     (if (memq service services)
                         result