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-PROCESS-MONITOR.


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

From: Attila Lendvai <attila@lendvai.name>

Assert that (CURRENT-PROCESS-MONITOR) is valid.

* modules/shepherd/service.scm (send-to-process-monitor): New function.
(handle-SIGCHLD), (process-monitor), (monitor-service-process),
(terminate-process): Use it.
---
 modules/shepherd/service.scm | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index d9dc0d5..e1c602c 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -2351,8 +2351,7 @@ otherwise by updating its state."
        #t)
       ((pid . status)
        ;; Let the process monitor handle it.
-       (put-message (current-process-monitor)
-                    `(handle-process-termination ,pid ,status))
+       (send-to-process-monitor `(handle-process-termination ,pid ,status))
 
        ;; As noted in libc's manual (info "(libc) Process Completion"),
        ;; loop so we don't miss any terminated child process.
@@ -2488,10 +2487,13 @@ which its completion status will be sent."
     (values (unboxed-errors (get-message reply))
             reply)))
 
+(define (send-to-process-monitor message)
+  (assert (current-process-monitor))
+  (put-message (current-process-monitor) message))
+
 (define (spawn-via-monitor arguments)
   (let ((reply (make-channel)))
-    (put-message (current-process-monitor)
-                 `(spawn ,arguments ,(current-service) ,reply))
+    (send-to-process-monitor `(spawn ,arguments ,(current-service) ,reply))
     (unboxed-errors (get-message reply))
     (get-message reply)))
 
@@ -2539,8 +2541,7 @@ while waiting for @var{program} to terminate."
   "Monitor process @var{pid} and notify @var{service} when it terminates."
   (assert (current-process-monitor))
   (let ((reply (make-channel)))
-    (put-message (current-process-monitor)
-                 `(await ,pid ,reply))
+    (send-to-process-monitor `(await ,pid ,reply))
     (spawn-fiber
      (lambda ()
        (let ((status (get-message reply)))
@@ -2583,7 +2584,7 @@ group; wait for @var{pid} to terminate and return its 
exit status.  If
 @var{pid} is still running @var{grace-period} seconds after @var{signal} has
 been sent, send it @code{SIGKILL}."
   (let ((reply (make-channel)))
-    (put-message (current-process-monitor) `(await ,(abs pid) ,reply))
+    (send-to-process-monitor `(await ,(abs pid) ,reply))
     (catch-system-error (kill pid signal))
 
     (match (get-message* reply grace-period #f)
@@ -2904,4 +2905,3 @@ we want to receive these signals."
       "This does not work for the 'root' service."
       (lambda (running)
        (local-output (l10n "You must be kidding.")))))))
-
-- 
2.45.2




reply via email to

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