civodul pushed a commit to branch main
in repository shepherd.
commit 8d88024e0898dd7d4581c4e977c9786af734a855
Author: Ludovic Courtès <l...@gnu.org>
AuthorDate: Sat Apr 12 17:34:21 2025 +0200
shepherd: ‘system*’ and ‘system’ replacements honor current directory.
Fixes <https://issues.guix.gnu.org/77707>.
* modules/shepherd.scm (main): Pass #:directory to ‘spawn-command’ for
‘system*’ replacement.
* modules/shepherd/service.scm (spawn-shell-command): Likewise.
* tests/system-star.sh: Test it.
* NEWS: Update.
Reported-by: Maxim Cournoyer <maxim.courno...@gmail.com>
---
NEWS | 6 ++++++
modules/shepherd.scm | 2 +-
modules/shepherd/service.scm | 3 ++-
tests/system-star.sh | 17 ++++++++++++++++-
4 files changed, 25 insertions(+), 3 deletions(-)
diff --git a/NEWS b/NEWS
index 3a212a0..f843b62 100644
--- a/NEWS
+++ b/NEWS
@@ -79,6 +79,12 @@ non-blocking (O_NONBLOCK) to the process it spawns, except
when using
This bug would manifest on GNU/Hurd where accept(2) in this child process
would return EAGAIN, which some daemons did not correctly handle.
+** ‘system*’ and ‘system’ replacements honor current directory
+ (<https://issues.guix.gnu.org/77707>)
+
+The ‘system*’ and ‘system’ replacements in the ‘shepherd’ process now run the
+given command in the current directory rather than under
+(default-service-directory).
* Changes in 1.0.3
diff --git a/modules/shepherd.scm b/modules/shepherd.scm
index a35a415..68e402b 100644
--- a/modules/shepherd.scm
+++ b/modules/shepherd.scm
@@ -584,7 +584,7 @@ fork in the child process."
;; and thus a continuation barrier. Replace it.
(put-char port #\newline)))
(system* (lambda command
- (spawn-command command)))
+ (spawn-command command #:directory (getcwd))))
(system spawn-shell-command)
(primitive-load primitive-load*)
(call-with-input-file call-with-input-file/close-on-exec)
diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 654506d..4cecf68 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -1891,7 +1891,8 @@ process is still running after @var{grace-period}
seconds, send it
This is similar to Guile's @code{system} procedure but does not block while
waiting for the shell to terminate."
(spawn-command (list (or (getenv "SHELL") "/bin/sh")
- "-c" command)))
+ "-c" command)
+ #:directory (getcwd)))
;; Produce a constructor that executes a command.
(define (make-system-constructor . command)
diff --git a/tests/system-star.sh b/tests/system-star.sh
index fc3cda7..4edcba2 100755
--- a/tests/system-star.sh
+++ b/tests/system-star.sh
@@ -1,5 +1,5 @@
# GNU Shepherd --- Test whether 'system*' is blocking.
-# Copyright © 2022-2023 Ludovic Courtès <l...@gnu.org>
+# Copyright © 2022-2023, 2025 Ludovic Courtès <l...@gnu.org>
#
# This file is part of the GNU Shepherd.
#
@@ -33,6 +33,8 @@ trap "cat $log || true; rm -f $socket $conf $stamp $log;
script="while [ ! -f $PWD/$stamp ] ; do sleep 0.1 ; done ; exit \$(cat
$PWD/$stamp)"
cat > "$conf" <<EOF
+(use-modules ((shepherd support) #:select (with-directory-excursion)))
+
(register-services
(list (service
'(test)
@@ -54,6 +56,12 @@ cat > "$conf" <<EOF
(zero? (system* "this command does not exist")))
#:stop (const #f)
#:respawn? #f)
+ (service
+ '(test-current-directory)
+ #:start (lambda _
+ (with-directory-excursion "${TMPDIR:-/tmp}"
+ (zero? (system "echo CWD: \$PWD"))))
+ #:respawn? #f)
(service
'(test-with-respawn)
#:start (make-forkexec-constructor
@@ -122,6 +130,13 @@ $herd start test-command-not-found && false
$herd status test-command-not-found
$herd status test-command-not-found | grep "stopped"
+# Check that 'system*' and 'system' run commands from the current working
+# directory rather than from (default-service-directory).
+$herd start test-current-directory
+$herd status test-current-directory | grep running
+grep "CWD: ${TMPDIR:-/tmp}" "$log"
+$herd stop test-current-directory
+
# What about a service with a custom 'stop' procedure that uses 'system*'?
# Stopping the service should not trigger the respawn machinery.
$herd start test-with-respawn
