From cca25a67693bb68a1884a081b415a43fad1e8641 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 25 May 2024 16:52:29 +0200
Subject: services: shepherd: Failure to load a service does not prevent
 booting.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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
---
 gnu/services/shepherd.scm | 35 ++++++++++++++++++++---------------
 1 file changed, 20 insertions(+), 15 deletions(-)

(limited to 'gnu')

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