[shepherd] 03/05: service: Registry replaces service anytime a same-named service is found.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository shepherd.

commit 1159223153e3c00f1e5a7e5a6de7694dbe83a735
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Wed Mar 22 22:16:36 2023 +0100

    service: Registry replaces service anytime a same-named service is found.
    
    * modules/shepherd/service.scm (service-registry): In 'register' clause,
    look for a service with any name provided by SERVICE, as opposed to just
    its canonical name.
---
 modules/shepherd/service.scm | 25 +++++++++++++------------
 1 file changed, 13 insertions(+), 12 deletions(-)

diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 0b27c03..ff1043d 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -978,18 +978,19 @@ requests arriving on @var{channel}."
 
     (match (get-message channel)
       (('register service)                        ;no reply
-       (let ((name (canonical-name service)))
-         (match (vhash-assq name registered)
-           (#f
-            (loop (register service)))
-           ((_ . old)
-            (let ((reply (make-channel)))
-              (put-message (service-control old)
-                           `(replace-if-running ,service ,reply))
-              (match (get-message reply)
-                (#t (loop registered))
-                (#f (loop (register service
-                                    (unregister (list old)))))))))))
+       (match (any (lambda (name)
+                     (vhash-assq name registered))
+                   (provided-by service))
+         (#f
+          (loop (register service)))
+         ((_ . old)
+          (let ((reply (make-channel)))
+            (put-message (service-control old)
+                         `(replace-if-running ,service ,reply))
+            (match (get-message reply)
+              (#t (loop registered))
+              (#f (loop (register service
+                                  (unregister (list old))))))))))
       (('unregister services)                     ;no reply
        (match (remove stopped? services)
          (()