[bug#54205] [PATCH v2] Factor out a public FORK-AND-CALL.

[Attila Lendvai]

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

v2: fixes the commit message.

 modules/shepherd/service.scm | 51 ++++++++++++++++++++----------------
 1 file changed, 29 insertions(+), 22 deletions(-)

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