guix-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[PATCH shepherd] service: Factor out SEND-TO-REGISTRY.


From: attila . lendvai
Subject: [PATCH shepherd] service: Factor out SEND-TO-REGISTRY.
Date: Sun, 30 Jun 2024 18:13:05 +0200

From: Attila Lendvai <attila@lendvai.name>

Also assert that (CURRENT-REGISTRY-CHANNEL) is valid.

* modules/shepherd/service.scm (with-service-registry): New function.
(stop-service), (fold-services), (service-name-count), (lookup-service),
(respawn-service), (register-services), (unregister-services): Use it.
---
 modules/shepherd/service.scm | 22 +++++++++++-----------
 1 file changed, 11 insertions(+), 11 deletions(-)

diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index e1c602c..b5f3e23 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -1030,8 +1030,7 @@ in a list."
                  (report-exception 'stop service key args))))))
 
         (when (transient-service? service)
-          (put-message (current-registry-channel)
-                       `(unregister ,(list service)))
+          (send-to-registry `(unregister ,(list service)))
           (local-output (l10n "Transient service ~a unregistered.")
                         (service-canonical-name service)))
 
@@ -1290,6 +1289,10 @@ task is one that should never fail)."
   (parameterize ((current-registry-channel (spawn-service-registry)))
     (thunk)))
 
+(define (send-to-registry message)
+  (assert (current-registry-channel))
+  (put-message (current-registry-channel) message))
+
 (define-syntax-rule (with-service-registry exp ...)
   "Spawn a new service monitor and evaluate @var{exp}... within that dynamic 
extent.
 This allows @var{exp}... and their callees to send requests to delegate
@@ -2286,8 +2289,7 @@ This must be paired with @code{make-systemd-destructor}."
     (lambda (proc init)
       "Apply PROC to the registered services to build a result, and return that
 result.  Works in a manner akin to `fold' from SRFI-1."
-      (put-message (current-registry-channel)
-                   `(service-list ,reply))
+      (send-to-registry `(service-list ,reply))
       (fold (match-lambda*
               (((name . service) result)
                (if (eq? name (service-canonical-name service))
@@ -2311,15 +2313,14 @@ returned in unspecified."
 (define (service-name-count)
   "Return the number of currently-registered service names."
   (let ((reply (make-channel)))
-    (put-message (current-registry-channel)
-                 `(service-name-count ,reply))
+    (send-to-registry `(service-name-count ,reply))
     (get-message reply)))
 
 (define lookup-service
   (let ((reply (make-channel)))
     (lambda (name)
       "Return the service that provides @var{name}, @code{#f} if there is 
none."
-      (put-message (current-registry-channel) `(lookup ,name ,reply))
+      (send-to-registry `(lookup ,name ,reply))
       (get-message reply))))
 
 (define (lookup-services name)
@@ -2631,7 +2632,7 @@ then disable it."
         (disable-service serv)
 
         (when (transient-service? serv)
-          (put-message (current-registry-channel) `(unregister (,serv)))
+          (send-to-registry `(unregister (,serv)))
           (local-output (l10n "Transient service ~a terminated, now 
unregistered.")
                         (service-canonical-name serv))))))
 
@@ -2657,7 +2658,7 @@ If it is currently stopped, replace it immediately."
         (assert (list-of-symbols? (service-requirement new)))
         (assert (boolean? (respawn-service? new)))
 
-        (put-message (current-registry-channel) `(register ,new)))
+        (send-to-registry `(register ,new)))
 
       (let ((services (if (service? services)
                           (begin
@@ -2681,8 +2682,7 @@ already stopped."
                 services))
 
   ;; Remove STOPPED from the registry.
-  (put-message (current-registry-channel)
-               `(unregister ,stopped))
+  (send-to-registry `(unregister ,stopped))
   #t)
 
 (define (deregister-service service-name)
-- 
2.45.2




reply via email to

[Prev in Thread] Current Thread [Next in Thread]