civodul pushed a commit to branch master in repository shepherd. commit a464e8b774174cdb594732b93358098305972bc1 Author: Ludovic Courtès <l...@gnu.org> Date: Mon Jan 25 23:06:20 2016 +0100
Use 'with-directory-excursion' for user-supplied directories. Before that the directory supplied in the command would change that current working directory of shepherd, and it would not be changed back. * modules/shepherd/support.scm (with-directory-excursion): New macro. * modules/shepherd.scm (process-command): Remove 'chdir' call. Use 'with-directory-excursion' instead. * tests/basic.sh: Test 'herd load root some-conf.scm'. --- modules/shepherd.scm | 16 ++++++++-------- modules/shepherd/support.scm | 12 ++++++++++++ tests/basic.sh | 26 ++++++++++++++++++++++++++ 3 files changed, 46 insertions(+), 8 deletions(-) diff --git a/modules/shepherd.scm b/modules/shepherd.scm index 5e26b4f..d258e7f 100644 --- a/modules/shepherd.scm +++ b/modules/shepherd.scm @@ -232,7 +232,6 @@ <shepherd-command> object. Send the reply to PORT." (match command (($ <shepherd-command> the-action service-symbol (args ...) dir) - (chdir dir) ;; We have to catch `quit' so that we can send the terminator ;; line to herd before we actually quit. @@ -254,14 +253,15 @@ port))) (define result - (case the-action - ((start) (apply start service-symbol args)) - ((stop) (apply stop service-symbol args)) - ((enforce) (apply enforce service-symbol args)) + (with-directory-excursion dir + (case the-action + ((start) (apply start service-symbol args)) + ((stop) (apply stop service-symbol args)) + ((enforce) (apply enforce service-symbol args)) - ;; Actions which have the semantics of `action' are - ;; handled there. - (else (apply action service-symbol the-action args)))) + ;; Actions which have the semantics of `action' are + ;; handled there. + (else (apply action service-symbol the-action args))))) (write-reply (command-reply command result #f (get-messages)) port)))) diff --git a/modules/shepherd/support.scm b/modules/shepherd/support.scm index 9bfb050..64cd313 100644 --- a/modules/shepherd/support.scm +++ b/modules/shepherd/support.scm @@ -32,6 +32,7 @@ EINTR-safe with-atomic-file-output mkdir-p + with-directory-excursion l10n local-output @@ -175,6 +176,17 @@ output port, and PROC's result is returned." (apply throw args)))))) (() #t)))) +(define-syntax-rule (with-directory-excursion dir body ...) ;copied from Guix + "Run BODY with DIR as the process's current directory." + (let ((init (getcwd))) + (dynamic-wind + (lambda () + (chdir dir)) + (lambda () + body ...) + (lambda () + (chdir init))))) + ;; Localized version of STR. diff --git a/tests/basic.sh b/tests/basic.sh index a20e9dc..b1603c6 100644 --- a/tests/basic.sh +++ b/tests/basic.sh @@ -120,6 +120,32 @@ $herd status | grep "Stopped: (test-2)" $herd reload root "$conf" test "`$herd status`" == "$pristine_status" +# Dynamically loading code. + +mkdir -p "$confdir" +cat > "$confdir/some-conf.scm" <<EOF +(register-services + (make <service> + #:provides '(test-loaded) + #:start (const 42) + #:stop (const #f))) +EOF + +if $herd status test-loaded +then false; else true; fi + +# Pass a relative file name and makes sure it's properly resolved. +(cd "$confdir" && herd -s "../$socket" load root "some-conf.scm") +rm "$confdir/some-conf.scm" + +# The new service should be loaded now. +$herd status test-loaded +$herd status test-loaded | grep stopped + +$herd start test-loaded +$herd status test-loaded | grep -i 'running.*42' +$herd stop test-loaded + # Unload everything and make sure only 'root' is left. $herd unload root all $herd status | grep "Stopped: ()"