[dmd] 03/03: Introduce 'fork+exec-command'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository dmd.

commit 1b4fe693ced4fe6b5280c23786101c6a481274a7
Author: Ludovic Courtès <address@hidden>
Date:   Tue Jun 24 00:08:40 2014 +0200

    Introduce 'fork+exec-command'.
    
    * modules/dmd/service.scm (fork+exec-command): New procedure.
      (make-forkexec-constructor): Use it.
    * dmd.texi (Service De- and Constructors): Document it.
---
 dmd.texi                |    8 +++++++-
 modules/dmd/service.scm |   24 ++++++++++++++++++------
 2 files changed, 25 insertions(+), 7 deletions(-)

diff --git a/dmd.texi b/dmd.texi
index d5fa881..1889c1c 100644
--- a/dmd.texi
+++ b/dmd.texi
@@ -827,16 +827,22 @@ in the destructor would immediately respawn the service.
 @end deffn
 
 The @code{make-forkexec-constructor} procedure builds upon the following
-procedure.
+procedures.
 
 @deffn {procedure} exec-command @var{command} @
   [#:directory (default-service-directory)] @
   [#:environment-variables (default-environment-variables)]
address@hidden {procedure} fork+exec-command @var{command} @
+  [#:directory (default-service-directory)] @
+  [#:environment-variables (default-environment-variables)]
 Run @var{command} as the current process from @var{directory}, and with
 @var{environment-variables} (a list of strings like @code{"PATH=/bin"}.)
 File descriptors 1 and 2 are kept as is, whereas file descriptor 0
 (standard input) points to @file{/dev/null}; all other file descriptors
 are closed prior to yielding control to @var{command}.
+
address@hidden does the same, but in a separate process whose
+PID it returns.
 @end deffn
 
 @c @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
diff --git a/modules/dmd/service.scm b/modules/dmd/service.scm
index 8b6266e..a706358 100644
--- a/modules/dmd/service.scm
+++ b/modules/dmd/service.scm
@@ -61,6 +61,7 @@
             make-forkexec-constructor
             make-kill-destructor
             exec-command
+            fork+exec-command
             make-system-constructor
             make-system-destructor
             make-init.d-service
@@ -603,6 +604,20 @@ yielding control to COMMAND."
                  program (strerror (system-error-errno args)))
          (primitive-exit 1))))))
 
+(define* (fork+exec-command command
+                            #:key
+                            (directory (default-service-directory))
+                            (environment-variables
+                             (default-environment-variables)))
+  "Spawn a process that executed COMMAND as per 'exec-command', and return
+its PID."
+  (let ((pid (primitive-fork)))
+    (if (zero? pid)
+        (exec-command command
+                      #:directory directory
+                      #:environment-variables environment-variables)
+        pid)))
+
 (define make-forkexec-constructor
   (let ((warn-deprecated-form
          ;; Until 0.1, this procedure took a rest list.
@@ -624,12 +639,9 @@ variables."
                            (list command))
                          command)))
         (lambda args
-          (let ((pid (primitive-fork)))
-            (if (zero? pid)
-                (exec-command command
-                              #:directory directory
-                              #:environment-variables environment-variables)
-                pid)))))
+          (fork+exec-command command
+                             #:directory directory
+                             #:environment-variables environment-variables))))
      ((program . program-args)
       ;; The old form, documented until 0.1 included.
       (warn-deprecated-form)