* 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