[shepherd] 02/02: service: Add 'unregister-services'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository shepherd.

commit b0eee0d037ccceb79c6db810063d129bba67f3f4
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sat Jul 15 21:38:18 2023 +0200

    service: Add 'unregister-services'.
    
    Suggested by Bruno Victal <mirai@makinata.eu>.
    Fixes <https://issues.guix.gnu.org/64365>.
    
    * modules/shepherd/service.scm (unregister-services): New procedure.
    (deregister-service)[deregister]: Remove.
    Use 'unregister-services' instead of 'deregister'.
    * doc/shepherd.texi (Service Registry): Document it.
    * NEWS: Mention it.
---
 NEWS                         |  5 +++++
 doc/shepherd.texi            |  5 +++++
 modules/shepherd/service.scm | 23 +++++++++++++++--------
 3 files changed, 25 insertions(+), 8 deletions(-)

diff --git a/NEWS b/NEWS
index b3d7d2e..d04f34b 100644
--- a/NEWS
+++ b/NEWS
@@ -54,6 +54,11 @@ Starting with version 0.9.0, calling the ‘daemonize’ action 
on the ‘root
 service would cause shepherd to miss signals; in particular, it would miss
 SIGCHLD signals, making it hardly usable.  This is now fixed.
 
+** New ‘unregister-services’ procedure
+   (<https://issues.guix.gnu.org/64365>)
+
+The (shepherd service) module now exports ‘unregister-services’.
+
 ** New Bash completion
 
 A Bash completion file is now installed, providing tab completion for the
diff --git a/doc/shepherd.texi b/doc/shepherd.texi
index 6d7ddfd..1799c5e 100644
--- a/doc/shepherd.texi
+++ b/doc/shepherd.texi
@@ -908,6 +908,11 @@ already been registered, arrange to have it replaced when 
it is next stopped.
 If it is currently stopped, replace it immediately.
 @end deffn
 
+@deffn {Procedure} unregister-services @var{services}
+Remove all of @var{services} from the registry, stopping them if they are not
+already stopped.
+@end deffn
+
 @deffn {Procedure} lookup-service @var{name}
 Return the service that provides @var{name}, @code{#f} if there is none.
 @end deffn
diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 7c9ea2e..c482c94 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -95,6 +95,7 @@
             spawn-shell-command
             %precious-signals
             register-services
+            unregister-services
 
             default-respawn-limit
             default-service-termination-handler
@@ -2554,6 +2555,19 @@ If it is currently stopped, replace it immediately."
       (warn-deprecated-form)
       (register-services services)))))
 
+(define (unregister-services services)
+  "Remove all of @var{services} from the registry, stopping them if they are 
not
+already stopped."
+  (for-each (lambda (service)
+              (unless (service-stopped? service)
+                (stop-service service)))
+            services)
+
+  ;; Remove SERVICE from the registry.
+  (put-message (current-registry-channel)
+               `(unregister ,services))
+  #t)
+
 (define (deregister-service service-name)
   "For each string in SERVICE-NAME, stop the associated service if
 necessary and remove it from the services table.  If SERVICE-NAME is
@@ -2562,13 +2576,6 @@ the special string 'all', remove all services except of 
'root'.
 This will remove a service either if it is identified by its canonical
 name, or if it is the only service providing the service that is
 requested to be removed."
-  (define (deregister service)
-    (when (service-running? service)
-      (stop-service service))
-    ;; Remove services provided by service from the hash table.
-    (put-message (current-registry-channel)
-                 `(unregister ,(list service))))
-
   (let ((name (string->symbol service-name)))
     (cond ((eq? name 'all)
            ;; Special 'remove all' case.
@@ -2587,7 +2594,7 @@ requested to be removed."
                   (local-output
                    "Removing service '~a' providing '~a'..."
                    (service-canonical-name service) name))
-              (deregister service)
+              (unregister-services (list service))
               (local-output (l10n "Done."))))))))
 
 (define (load-config file-name)