Ludovic Courtès <l...@gnu.org> writes:
> What would be nice is to provide in (shepherd support) or similar a
> ‘home-environment-variables’ procedure (or similar) that would add HOME=
> and USER= to the given list of environment variables.
>
> That would avoid duplication of the boilerplate above.
>
> If you’d like to submit such a patch, it’d be welcome!
Would something like the attached work? I placed the procedure directly
into the (shepherd service) module, since the point is to reduce
boilerplate, I thought it better to not having to specify (modules
'((shepherd support))) every time someone wants to use it, but I can
move it if you prefer.
>From f330b8df42b554d6388487df9a81d87bb4ac5071 Mon Sep 17 00:00:00 2001
From: Tomas Volf <~@wolfsden.cz>
Date: Thu, 3 Apr 2025 13:19:26 +0200
Subject: [PATCH] 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.
---
Makefile.am | 1 +
doc/shepherd.texi | 9 +++++++++
modules/shepherd/service.scm | 16 ++++++++++++++-
tests/service.scm | 38 ++++++++++++++++++++++++++++++++++++
4 files changed, 63 insertions(+), 1 deletion(-)
create mode 100644 tests/service.scm
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..e94496b 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 of 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 5477aa5..c03c2c4 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
@@ -1484,6 +1485,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))
@@ -2986,4 +3001,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..1826306
--- /dev/null
+++ b/tests/service.scm
@@ -0,0 +1,38 @@
+;; GNU Shepherd --- Test the service module.
+;; Copyright © 2025 Tomas Volf <~@wolfsden.cz>
+;;
+;; 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 "user-environment-variables")
+
+(let ((environment-variables '("USER=foo"
+ "HOME=/foo"
+ "USER=bar"
+ "HOME=/bar")))
+ ;; Pretty much any system should have root in /etc/passwd.
+ (test-equal "name sets variables"
+ '("HOME=/root" "USER=root")
+ (user-environment-variables "root" environment-variables))
+ (test-equal "id sets variables"
+ '("HOME=/root" "USER=root")
+ (user-environment-variables 0 environment-variables)))
+
+(test-end)
--
2.49.0
--
There are only two hard things in Computer Science:
cache invalidation, naming things and off-by-one errors.
