From mboxrd@z Thu Jan 1 00:00:00 1970 From: David Craven Subject: [PATCH] service: Honor #:log-file in make-forkexec-constructor. Date: Tue, 6 Sep 2016 14:35:36 +0200 Message-ID: <20160906123536.1321-1-david@craven.ch> References: <878tv6uk0v.fsf@gnu.org> Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:43407) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bhFba-0001q1-L2 for guix-devel@gnu.org; Tue, 06 Sep 2016 08:35:59 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1bhFbW-0002v3-9E for guix-devel@gnu.org; Tue, 06 Sep 2016 08:35:57 -0400 Received: from so254-10.mailgun.net ([198.61.254.10]:47326) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bhFbV-0002ub-0u for guix-devel@gnu.org; Tue, 06 Sep 2016 08:35:54 -0400 In-Reply-To: <878tv6uk0v.fsf@gnu.org> List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: "Guix-devel" To: guix-devel@gnu.org * 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