From 51ee63ace6f3f52eb196c990664cc6b9af3d3683 Mon Sep 17 00:00:00 2001 From: ulfvonbelow Date: Sat, 25 Feb 2023 00:46:27 -0600 Subject: [PATCH 2/3] service: accept fork+exec-command argument list in monitor. Sometimes it's necessary to run startup / shutdown programs as a certain user, in a certain directory, with certain environment variables, etc. Shepherd currently provides a replacement for system* that won't race against the child process auto-reaper, but this lacks the flexibility Shepherd users are used to. * modules/shepherd/service.scm (process-monitor): treat command instead as argument list to fork+exec-command. (spawn-via-monitor): update to new convention. (fork+exec+wait-command): new procedure. --- modules/shepherd/service.scm | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm index 196ee44..a36e486 100644 --- a/modules/shepherd/service.scm +++ b/modules/shepherd/service.scm @@ -94,6 +94,7 @@ default-process-termination-grace-period exec-command fork+exec-command + fork+exec+wait-command default-pid-file-timeout read-pid-file make-system-constructor @@ -1877,12 +1878,12 @@ otherwise by updating its state." vlist-null waiters))) - (('spawn command reply) + (('spawn args reply) ;; Spawn COMMAND; send the spawn result (pid or exception) to REPLY; ;; send its exit status to REPLY when it terminates. This operation is ;; atomic: the WAITERS table is updated before termination of PID can ;; possibly be handled. - (let ((result (boxed-errors (fork+exec-command command)))) + (let ((result (boxed-errors (apply fork+exec-command args)))) (put-message reply result) (match result (('exception . _) @@ -1924,19 +1925,26 @@ context. The process monitoring fiber is responsible for handling @code{SIGCHLD} and generally dealing with process creation and termination." (call-with-process-monitor (lambda () exp ...))) -(define (spawn-via-monitor command) +(define (spawn-via-monitor arguments) (let ((reply (make-channel))) (put-message (current-process-monitor) - `(spawn ,command ,reply)) + `(spawn ,arguments ,reply)) (unboxed-errors (get-message reply)) (get-message reply))) (define (spawn-command program . arguments) "Like 'system*' but do not block while waiting for PROGRAM to terminate." (if (current-process-monitor) - (spawn-via-monitor (cons program arguments)) + (spawn-via-monitor (list (cons program arguments))) (apply system* program arguments))) +(define (fork+exec+wait-command command . arguments) + "Like 'fork+exec' but also wait for PROGRAM to terminate, giving its exit +status." + (if (current-process-monitor) + (spawn-via-monitor (cons command arguments)) + (waitpid (apply fork+exec-command command arguments)))) + (define default-process-termination-grace-period ;; Default process termination "grace period" before we send SIGKILL. (make-parameter 5)) -- 2.38.1