[PATCH] service: Honor #:log-file in make-forkexec-constructor.

[David Craven <david@craven.ch>]

* modules/shepherd/service.scm (exec-command): Redirect stdout and
  stderr to log-file.
  (fork+exec-command): Pass log-file to exec-command.
  (make-forkexec-constructor): Cleanup log-file. Pass log-file to
  fork+exec-command.
* doc/shepherd.texi (@deffn): Update documentation.
---
 doc/shepherd.texi            |  5 +++++
 modules/shepherd/service.scm | 43 ++++++++++++++++++++++++++++++++++---------
 2 files changed, 39 insertions(+), 9 deletions(-)

diff --git a/doc/shepherd.texi b/doc/shepherd.texi
index edb2039..d7ce3fe 100644
--- a/doc/shepherd.texi
+++ b/doc/shepherd.texi
@@ -835,6 +835,7 @@ execution of the @var{command} was successful, @code{#t} if not.
   [#:user #f] @
   [#:group #f] @
   [#:pid-file #f] @
+  [#:log-file #f] @
   [#:directory (default-service-directory)] @
   [#:environment-variables (default-environment-variables)]
 Return a procedure that forks a child process, closes all file
@@ -848,6 +849,10 @@ the procedure will be the PID of the child process.
 When @var{pid-file} is true, it must be the name of a PID file
 associated with the process being launched; the return value is the PID
 read from that file, once that file has been created.
+
+When @var{log-file} is true, it must be the name of a file. The file will
+be removed if it exists and the services stdout and stderr will be
+redirected to it.
 @end deffn
 
 @deffn {procedure} make-kill-destructor [@var{signal}]
diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 49f6e8b..d3fb348 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -687,6 +687,7 @@ number that was read (a PID)."
                        #:key
                        (user #f)
                        (group #f)
+                       (log-file #f)
                        (directory (default-service-directory))
                        (environment-variables (default-environment-variables)))
   "Run COMMAND as the current process from DIRECTORY, and with
@@ -712,12 +713,27 @@ false."
 
      ;; Close all the file descriptors except stdout and stderr.
      (let ((max-fd (max-file-descriptors)))
-       (catch-system-error (close-fdes 0))
 
+       ;; Redirect stdin to use /dev/null
+       (catch-system-error (close-fdes 0))
        ;; Make sure file descriptor zero is used, so we don't end up reusing
        ;; it for something unrelated, which can confuse some packages.
        (dup2 (open-fdes "/dev/null" O_RDONLY) 0)
 
+       (when log-file
+         (catch #t
+           (lambda ()
+             ;; Redirect stout and stderr to use LOG-FILE.
+             (catch-system-error (close-fdes 1))
+             (catch-system-error (close-fdes 2))
+             (dup2 (open-fdes log-file (logior O_CREAT O_WRONLY)) 1)
+             (dup2 (open-fdes log-file (logior O_CREAT O_WRONLY)) 2))
+           (lambda (key . args)
+             (format (current-error-port)
+                     "failed to open log-file ~s:~%" log-file)
+             (print-exception (current-error-port) #f key args)
+             (primitive-exit 1))))
+
        (let loop ((i 3))
          (when (< i max-fd)
            (catch-system-error (close-fdes i))
@@ -760,6 +776,7 @@ false."
                             #:key
                             (user #f)
                             (group #f)
+                            (log-file #f)
                             (directory (default-service-directory))
                             (environment-variables
                              (default-environment-variables)))
@@ -770,6 +787,7 @@ its PID."
         (exec-command command
                       #:user user
                       #:group group
+                      #:log-file log-file
                       #:directory directory
                       #:environment-variables environment-variables)
         pid)))
@@ -798,24 +816,31 @@ once that file has been created."
                (group #f)
                (directory (default-service-directory))
                (environment-variables (default-environment-variables))
-               (pid-file #f))
+               (pid-file #f)
+               (log-file #f))
       (let ((command (if (string? command)
                          (begin
                            (warn-deprecated-form)
                            (list command))
                          command)))
         (lambda args
-          (when pid-file
-            (catch 'system-error
-              (lambda ()
-                (delete-file pid-file))
-              (lambda args
-                (unless (= ENOENT (system-error-errno args))
-                  (apply throw args)))))
+          (define (clean-up file)
+            (when file
+              (catch 'system-error
+                (lambda ()
+                  (delete-file file))
+                (lambda args
+                  (unless (= ENOENT (system-error-errno args))
+                    (apply throw args))))))
+
+          (clean-up pid-file)
+          (clean-up log-file)
 
           (let ((pid (fork+exec-command command
+
                                         #:user user
                                         #:group group
+                                        #:log-file log-file
                                         #:directory directory
                                         #:environment-variables
                                         environment-variables)))
-- 
2.9.0