[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[shepherd] 03/03: service: Add #:pid-file to 'make-forkexec-constructor'
From: |
Ludovic Courtès |
Subject: |
[shepherd] 03/03: service: Add #:pid-file to 'make-forkexec-constructor'. |
Date: |
Sun, 24 Jan 2016 23:11:11 +0000 |
civodul pushed a commit to branch master
in repository shepherd.
commit 710e9b3851de5e1d68c12d6ac1fe2bf8cf53b011
Author: Ludovic Courtès <address@hidden>
Date: Mon Jan 25 00:02:26 2016 +0100
service: Add #:pid-file to 'make-forkexec-constructor'.
* modules/shepherd/service.scm (read-pid-file): New procedure.
(make-forkexec-constructor): Add #:pid-file parameter and honor it.
* tests/respawn.sh: Change 'test2' to use #:pid-file. Use 'test -f'
instead of 'wait_for_file' for $service2_pid.
* shepherd.texi (Service De- and Constructors): Adjust accordingly.
---
modules/shepherd/service.scm | 66 +++++++++++++++++++++++++++++++++++-------
shepherd.texi | 19 +++++++----
tests/respawn.sh | 18 +++++++----
3 files changed, 79 insertions(+), 24 deletions(-)
diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index cf72f8b..f84d1dd 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -25,6 +25,7 @@
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
+ #:use-module (rnrs io ports)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:use-module (shepherd support)
@@ -66,6 +67,7 @@
make-kill-destructor
exec-command
fork+exec-command
+ read-pid-file
make-system-constructor
make-system-destructor
make-init.d-service
@@ -636,6 +638,29 @@ results."
set when starting a service."
(environ))
+(define* (read-pid-file file #:key (max-delay 5))
+ "Wait for MAX-DELAY seconds for FILE to show up, and read its content as a
+number. Return #f if FILE does not contain a number; otherwise return the
+number that was read (a PID)."
+ (define start (current-time))
+ (let loop ()
+ (catch 'system-error
+ (lambda ()
+ (string->number
+ (string-trim-both
+ (call-with-input-file file get-string-all))))
+ (lambda args
+ (let ((errno (system-error-errno args)))
+ (if (and (= ENOENT errno)
+ (< (current-time) (+ start max-delay)))
+ (begin
+ ;; FILE does not exist yet, so wait and try again.
+ ;; XXX: Ideally we would yield to the main event loop
+ ;; and/or use inotify.
+ (sleep 1)
+ (loop))
+ (apply throw args)))))))
+
(define* (exec-command command
#:key
(user #f)
@@ -735,27 +760,46 @@ its PID."
"This 'make-forkexec-constructor' form is deprecated; use
(make-forkexec-constructor '(\"PROGRAM\" \"ARGS\"...)."))))
(case-lambda*
- "Produce a constructor that execs COMMAND, a program name/argument list,
-in a child process and returns its PID. COMMAND is started with
-DIRECTORY as its current directory, and ENVIRONMENT-VARIABLES as its
-environment variables. If USER and/or GROUP are given, switch to the
-given USER and/or GROUP to run COMMAND."
+ "Return a procedure that forks a child process, closes all file
+descriptors except the standard output and standard error descriptors, sets
+the current directory to @var{directory}, changes the environment to
address@hidden (using the @code{environ} procedure), sets the
+current user to @var{user} and the current group to @var{group} unless they
+are @code{#f}, and executes @var{command} (a list of strings.) The result of
+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."
((command #:key
(user #f)
(group #f)
(directory (default-service-directory))
- (environment-variables (default-environment-variables)))
+ (environment-variables (default-environment-variables))
+ (pid-file #f))
(let ((command (if (string? command)
(begin
(warn-deprecated-form)
(list command))
command)))
(lambda args
- (fork+exec-command command
- #:user user
- #:group group
- #:directory directory
- #:environment-variables environment-variables))))
+ (when pid-file
+ (catch 'system-error
+ (lambda ()
+ (delete-file pid-file))
+ (lambda args
+ (unless (= ENOENT (system-error-errno args))
+ (apply throw args)))))
+
+ (let ((pid (fork+exec-command command
+ #:user user
+ #:group group
+ #:directory directory
+ #:environment-variables
+ environment-variables)))
+ (if pid-file
+ (read-pid-file pid-file)
+ pid)))))
((program . program-args)
;; The old form, documented until 0.1 included.
(warn-deprecated-form)
diff --git a/shepherd.texi b/shepherd.texi
index ef1d9da..74cf584 100644
--- a/shepherd.texi
+++ b/shepherd.texi
@@ -833,15 +833,20 @@ execution of the @var{command} was successful, @code{#t}
if not.
@deffn {procedure} make-forkexec-constructor @var{command} @
[#:user #f] @
[#:group #f] @
+ [#:pid-file #f] @
[#:directory (default-service-directory)] @
[#:environment-variables (default-environment-variables)]
-Return a procedure that forks a child process, close all file
-descriptors except the standard output and standard error descriptors,
-sets the current directory to @var{directory}, changes the environment
-to @var{environment-variables} (using the @code{environ} procedure),
-sets the current user to @var{user} and the current group to
address@hidden, and executes @var{command} (a list of strings.) The
-result of the procedure will be the PID of the child process.
+Return a procedure that forks a child process, closes all file
+descriptors except the standard output and standard error descriptors, sets
+the current directory to @var{directory}, changes the environment to
address@hidden (using the @code{environ} procedure), sets the
+current user to @var{user} and the current group to @var{group} unless they
+are @code{#f}, and executes @var{command} (a list of strings.) The result of
+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.
@end deffn
@deffn {procedure} make-kill-destructor address@hidden
diff --git a/tests/respawn.sh b/tests/respawn.sh
index 057c3ea..32d18db 100644
--- a/tests/respawn.sh
+++ b/tests/respawn.sh
@@ -73,12 +73,15 @@ cat > "$conf"<<EOF
(make <service>
#:provides '(test2)
#:start (make-forkexec-constructor
+ ;; The 'sleep' below is just to make it more likely
+ ;; that synchronization issues in handling #:pid-file
+ ;; would be caught.
'("$SHELL" "-c"
- "echo \$\$ > $PWD/$service2_pid ; while true ; do sleep 1 ;
done"))
+ "sleep 0.7 ; echo \$\$ > $PWD/$service2_pid ; while true ; do
sleep 1 ; done")
+ #:pid-file "$PWD/$service2_pid")
#:stop (make-kill-destructor)
#:respawn? #t))
(start 'test1)
-(start 'test2)
EOF
rm -f "$pid"
@@ -93,13 +96,16 @@ kill -0 $dmd_pid
test -S "$socket"
$herd status
$herd status test1 | grep started
+
+$herd start test2
$herd status test2 | grep started
-# The services are started, but that does not mean that they have
-# written their PID file yet, so use 'wait_for_file' rather than
-# 'test -f'.
+# When 'herd start test2' returns, the PID file must already be created.
+test -f "$service2_pid"
+
+# Conversely, 'test1' may not have written its PID file yet, so use
+# 'wait_for_file' rather than 'test -f'.
wait_for_file "$service1_pid"
-wait_for_file "$service2_pid"
# Make sure the PIDs are valid.
kill -0 `cat "$service1_pid"`