01/05: services: shepherd: Load each service file in a fresh module.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 6f9d844d2ece7b369d17bbe678978462425f869c
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Wed Mar 20 18:48:38 2024 +0100

    services: shepherd: Load each service file in a fresh module.
    
    Fixes <https://issues.guix.gnu.org/67649>.
    
    * gnu/home/services/shepherd.scm (home-shepherd-configuration-file)[config]:
    Define ‘make-user-module’.  Call ‘load’ in ‘save-module-excursion’.
    * gnu/services/shepherd.scm (shepherd-configuration-file): Likewise.
    
    Reported-by: Attila Lendvai <attila@lendvai.name>
    Change-Id: I7df11c81b5bbbf2b24a8daa02502a000e0826fe0
---
 gnu/home/services/shepherd.scm | 14 +++++++++++++-
 gnu/services/shepherd.scm      | 13 ++++++++++++-
 2 files changed, 25 insertions(+), 2 deletions(-)

diff --git a/gnu/home/services/shepherd.scm b/gnu/home/services/shepherd.scm
index 176f4575cb..962e633618 100644
--- a/gnu/home/services/shepherd.scm
+++ b/gnu/home/services/shepherd.scm
@@ -77,7 +77,19 @@ as shepherd package."
           (use-modules (srfi srfi-34)
                        (system repl error-handling))
 
-          (register-services (map load '#$files))
+          (define (make-user-module)
+            ;; Copied from (shepherd support), where it's private.
+            (let ((m (make-fresh-user-module)))
+              (module-use! m (resolve-interface '(shepherd service)))
+              m))
+
+          (register-services
+           (map (lambda (file)
+                  (save-module-excursion
+                   (lambda ()
+                     (set-current-module (make-user-module))
+                     (load file))))
+                '#$files))
 
           #$@(if daemonize?
                  `((action 'root 'daemonize))
diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm
index f5bcde721f..455e972535 100644
--- a/gnu/services/shepherd.scm
+++ b/gnu/services/shepherd.scm
@@ -383,6 +383,12 @@ as shepherd package."
           (use-modules (srfi srfi-34)
                        (system repl error-handling))
 
+          (define (make-user-module)
+            ;; Copied from (shepherd support), where it's private.
+            (let ((m (make-fresh-user-module)))
+              (module-use! m (resolve-interface '(shepherd service)))
+              m))
+
           ;; There's code run from shepherd that uses 'call-with-input-file' &
           ;; co.--e.g., the 'urandom-seed' service.  Starting from Shepherd
           ;; 0.9.2, users need to make sure not to leak non-close-on-exec file
@@ -416,7 +422,12 @@ as shepherd package."
               (register-services
                (parameterize ((current-warning-port
                                (%make-void-port "w")))
-                 (map load-compiled '#$(map scm->go files))))))
+                 (map (lambda (file)
+                        (save-module-excursion
+                         (lambda ()
+                           (set-current-module (make-user-module))
+                           (load-compiled file))))
+                      '#$(map scm->go files))))))
 
           (format #t "starting services...~%")
           (let ((services-to-start