civodul pushed a commit to branch main
in repository shepherd.
commit 15f8cb4d2968c010bbd2b55f971633f0c008c8d7
Author: Tomas Volf <[email protected]>
AuthorDate: Wed Apr 16 00:16:14 2025 +0200
service: Add user-environment-variables procedure.
* modules/shepherd/service.scm (user-environment-variables): New procedure.
* doc/shepherd.texi (Service De- and Constructors): Document it.
* tests/service.scm: And test it.
Signed-off-by: Ludovic Courtès <[email protected]>
---
Makefile.am | 1 +
doc/shepherd.texi | 9 +++++++++
modules/shepherd/service.scm | 16 +++++++++++++++-
tests/service.scm | 43 +++++++++++++++++++++++++++++++++++++++++++
4 files changed, 68 insertions(+), 1 deletion(-)
diff --git a/Makefile.am b/Makefile.am
index 7404009..a61b403 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -296,6 +296,7 @@ TESTS = \
tests/syslog-slow-output.sh \
tests/terminate-before-running.sh \
tests/unload.sh \
+ tests/service.scm \
tests/services/monitoring.sh \
tests/services/repl.sh \
tests/services/timer.sh \
diff --git a/doc/shepherd.texi b/doc/shepherd.texi
index f826b74..2da92e3 100644
--- a/doc/shepherd.texi
+++ b/doc/shepherd.texi
@@ -1203,6 +1203,15 @@ returns when the program starts (@pxref{Runtime
Environment,
@code{environ},, guile, GNU Guile Reference Manual}).
@end defvar
+@deffn {Procedure} user-environment-variables @
+ [name-or-id (getuid)] @
+ [environment-variables (default-environment-variables)]
+
+Take the list @var{environment-variables}, replace @env{HOME} with home
+directory of the user and @env{USER} with the name of the user and
+return the result.
+@end deffn
+
@defvar default-pid-file-timeout
This parameter (@pxref{Parameters,,, guile, GNU Guile Reference Manual})
specifies the default PID file timeout in seconds, when
diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 2e39b72..5b66ab8 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -127,6 +127,7 @@
default-respawn-delay
default-service-termination-handler
default-environment-variables
+ user-environment-variables
default-service-directory
make-forkexec-constructor
make-kill-destructor
@@ -1486,6 +1487,20 @@ background:~{ ~a~}."
;; set when starting a service.
(make-parameter '()))
+(define* (user-environment-variables #:optional
+ (name-or-id (getuid))
+ (environment-variables
+ (default-environment-variables)))
+ "Return the value of @var{environment-variables} with @env{HOME} and
+@env{USER} replaced by correct values for user @var{name-or-id}."
+ (let ((pw (getpw name-or-id)))
+ (cons* (string-append "HOME=" (passwd:dir pw))
+ (string-append "USER=" (passwd:name pw))
+ (remove (lambda (x)
+ (or (string-prefix? "HOME=" x)
+ (string-prefix? "USER=" x)))
+ environment-variables))))
+
(define default-pid-file-timeout
;; Maximum number of seconds to wait for a PID file to show up.
(make-parameter 5))
@@ -2992,4 +3007,3 @@ we want to receive these signals."
"This does not work for the 'root' service."
(lambda (running)
(local-output (l10n "You must be kidding.")))))))
-
diff --git a/tests/service.scm b/tests/service.scm
new file mode 100644
index 0000000..a802a39
--- /dev/null
+++ b/tests/service.scm
@@ -0,0 +1,43 @@
+;; GNU Shepherd --- Test the service module.
+;; Copyright © 2025 Tomas Volf <[email protected]>
+;;
+;; This file is part of the GNU Shepherd.
+;;
+;; The GNU Shepherd is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3 of the License, or (at
+;; your option) any later version.
+;;
+;; The GNU Shepherd is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with the GNU Shepherd. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (test-service)
+ #:use-module (shepherd service)
+ #:use-module (srfi srfi-64))
+
+
+(test-begin "service")
+
+(let* ((environment-variables '("USER=foo"
+ "HOME=/foo"
+ "USER=bar"
+ "HOME=/bar"))
+
+ (passwd (getpwuid (getuid)))
+ (user (passwd:name passwd))
+
+ (expected (list (string-append "HOME=" (passwd:dir passwd))
+ (string-append "USER=" user))))
+ (test-equal "name sets variables"
+ expected
+ (user-environment-variables user environment-variables))
+ (test-equal "id sets variables"
+ expected
+ (user-environment-variables (getuid) environment-variables)))
+
+(test-end)
