[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[shepherd] 01/01: service: Honor #:log-file in make-forkexec-constructor
From: |
Ludovic Courtès |
Subject: |
[shepherd] 01/01: service: Honor #:log-file in make-forkexec-constructor. |
Date: |
Sun, 11 Sep 2016 13:34:22 +0000 (UTC) |
civodul pushed a commit to branch master
in repository shepherd.
commit 3ccc24392aacff4705a1f397d43e25eaef76d791
Author: David Craven <address@hidden>
Date: Tue Sep 6 14:35:36 2016 +0200
service: Honor #:log-file in make-forkexec-constructor.
* 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.
Signed-off-by: Ludovic Courtès <address@hidden>
---
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 address@hidden
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)))