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
This commit is contained in:
Ludovic Courtès 2024-03-20 18:48:38 +01:00
parent 2b052fe3c0
commit 6f9d844d2e
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 25 additions and 2 deletions

View file

@ -77,7 +77,19 @@ (define config
(use-modules (srfi srfi-34) (use-modules (srfi srfi-34)
(system repl error-handling)) (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? #$@(if daemonize?
`((action 'root 'daemonize)) `((action 'root 'daemonize))

View file

@ -383,6 +383,12 @@ (define config
(use-modules (srfi srfi-34) (use-modules (srfi srfi-34)
(system repl error-handling)) (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' & ;; There's code run from shepherd that uses 'call-with-input-file' &
;; co.--e.g., the 'urandom-seed' service. Starting from Shepherd ;; 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 ;; 0.9.2, users need to make sure not to leak non-close-on-exec file
@ -416,7 +422,12 @@ (define config
(register-services (register-services
(parameterize ((current-warning-port (parameterize ((current-warning-port
(%make-void-port "w"))) (%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...~%") (format #t "starting services...~%")
(let ((services-to-start (let ((services-to-start