services: shepherd: Failure to load a service does not prevent booting.

Fixes <https://issues.guix.gnu.org/71144>.

Fixes a bug whereby, when loading a service file would fail, for
instance due to an unbound variable, a REPL would be opened on the
console, preventing the system from booting.

This fixes that by isolating service load errors and making them
non-fatal.

* gnu/services/shepherd.scm (shepherd-configuration-file)[config]:
Remove call to ‘call-with-error-handling’.  Use ‘filter-map’ instead of
‘map’ to iterate over service files, and catch exceptions raised by
‘load-compiled’.

Change-Id: Ie6e76ea514837f85386232f797bc77b2882b5c22
This commit is contained in:
Ludovic Courtès 2024-05-25 16:52:29 +02:00
parent 5a7cb59648
commit cca25a6769
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -380,8 +380,7 @@ (define (shepherd-configuration-file services shepherd)
(scm->go (cute scm->go <> shepherd))) (scm->go (cute scm->go <> shepherd)))
(define config (define config
#~(begin #~(begin
(use-modules (srfi srfi-34) (use-modules (srfi srfi-1))
(system repl error-handling))
(define (make-user-module) (define (make-user-module)
;; Copied from (shepherd support), where it's private. ;; Copied from (shepherd support), where it's private.
@ -415,19 +414,25 @@ (define (make-user-module)
;; <https://bugs.gnu.org/40572>. ;; <https://bugs.gnu.org/40572>.
(default-pid-file-timeout 30) (default-pid-file-timeout 30)
;; Arrange to spawn a REPL if something goes wrong. This is better ;; Load service files one by one; filter out those that could not be
;; than a kernel panic. ;; loaded--e.g., due to an unbound variable--such that an error in
(call-with-error-handling ;; one service definition does not prevent the system from booting.
(lambda () (register-services
(register-services (parameterize ((current-warning-port (%make-void-port "w")))
(parameterize ((current-warning-port (filter-map (lambda (file)
(%make-void-port "w"))) (with-exception-handler
(map (lambda (file) (lambda (exception)
(save-module-excursion (format #t "Exception caught \
(lambda () while loading '~a': ~s~%"
(set-current-module (make-user-module)) file exception)
(load-compiled file)))) #f)
'#$(map scm->go files)))))) (lambda ()
(save-module-excursion
(lambda ()
(set-current-module (make-user-module))
(load-compiled file))))
#:unwind? #t))
'#$(map scm->go files))))
(format #t "starting services...~%") (format #t "starting services...~%")
(let ((services-to-start (let ((services-to-start