From: Attila Lendvai <att...@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
