(address . guix-patches@gnu.org)(name . Attila Lendvai)(address . attila@lendvai.name)
This enables service implementations to easily inject code that is run before
their service is started. One such example is calling setrlimit from a start
action to set NOFILE (the open files limit), before the service is exec'ed and
thus inherits this value from the parent process, i.e. from Shepherd.
* modules/shepherd/service.scm (fork-and-call): New function.
(fork+exec-command): Use the above.
---
modules/shepherd/service.scm | 51 ++++++++++++++++++++----------------
1 file changed, 29 insertions(+), 22 deletions(-)
Toggle diff (80 lines)
diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index ad8608b..8d5e30f 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -79,6 +79,7 @@
make-forkexec-constructor
make-kill-destructor
exec-command
+ fork-and-call
fork+exec-command
default-pid-file-timeout
read-pid-file
@@ -883,19 +884,8 @@ false."
;; Signals that the shepherd process handles.
(list SIGCHLD SIGINT SIGHUP SIGTERM))
-(define* (fork+exec-command command
- #:key
- (user #f)
- (group #f)
- (supplementary-groups '())
- (log-file #f)
- (directory (default-service-directory))
- (file-creation-mask #f)
- (create-session? #t)
- (environment-variables
- (default-environment-variables)))
- "Spawn a process that executed COMMAND as per 'exec-command', and return
-its PID."
+(define* (fork-and-call thunk)
+ "Call THUNK in a fork."
;; Install the SIGCHLD handler if this is the first fork+exec-command call.
(unless %sigchld-handler-installed?
(sigaction SIGCHLD handle-SIGCHLD SA_NOCLDSTOP)
@@ -916,17 +906,34 @@ its PID."
;; process.
(unblock-signals %precious-signals)
- (exec-command command
- #:user user
- #:group group
- #:supplementary-groups supplementary-groups
- #:log-file log-file
- #:directory directory
- #:file-creation-mask file-creation-mask
- #:create-session? create-session?
- #:environment-variables environment-variables))
+ (thunk))
pid))))
+(define* (fork+exec-command command
+ #:key
+ (user #f)
+ (group #f)
+ (supplementary-groups '())
+ (log-file #f)
+ (directory (default-service-directory))
+ (file-creation-mask #f)
+ (create-session? #t)
+ (environment-variables
+ (default-environment-variables)))
+ "Spawn a process that executed COMMAND as per 'exec-command', and return
+its PID."
+ (fork-and-call
+ (lambda ()
+ (exec-command command
+ #:user user
+ #:group group
+ #:supplementary-groups supplementary-groups
+ #:log-file log-file
+ #:directory directory
+ #:file-creation-mask file-creation-mask
+ #:create-session? create-session?
+ #:environment-variables environment-variables))))
+
(define* (make-forkexec-constructor command
#:key
(user #f)
--
2.34.0