From a6642650a78a11e4d3b4cff78e423c600fab7021 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Mon, 6 Jan 2025 13:46:59 +0100
Subject: [PATCH] =?UTF-8?q?reconfigure:=20Make=20=E2=80=98load-system-for-?=
 =?UTF-8?q?kexec=E2=80=99=20errors=20non-fatal.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Partially fixes <https://issues.guix.gnu.org/75215>.

* guix/scripts/system/reconfigure.scm (load-system-for-kexec): Catch
exceptions in the gexp.  Report them outside.

Reported-by: Luis Guilherme Coelho <lgcoelho@disroot.org>
Change-Id: Iebcdc92e29b8623a55967d58a4f353abab01631a
---
 guix/scripts/system/reconfigure.scm | 33 +++++++++++++++++++++++++----
 1 file changed, 29 insertions(+), 4 deletions(-)

diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm
index 96e5bff351..d35980590d 100644
--- a/guix/scripts/system/reconfigure.scm
+++ b/guix/scripts/system/reconfigure.scm
@@ -230,10 +230,35 @@ services as defined by OS."
                                                             to-restart)))))))
 
 (define (load-system-for-kexec eval os)
-  "Load OS so that it can be rebooted into via kexec, if supported.  Return
-true on success."
-  (eval #~(and (string-contains %host-type "-linux")
-               (primitive-load #$(kexec-loading-program os)))))
+  "Load OS so that it can be rebooted into via kexec, if supported.  Print a
+warning in case of failure."
+  (mlet %store-monad
+      ((result (eval
+                #~(and (string-contains %host-type "-linux")
+                       (with-exception-handler
+                           (lambda (c)
+                             (define kind-and-args?
+                               (exception-predicate &exception-with-kind-and-args))
+
+                             (list 'exception
+                                   (if (kind-and-args? c)
+                                       (call-with-output-string
+                                         (lambda (port)
+                                           (print-exception port #f
+                                                            (exception-kind c)
+                                                            (exception-args c))))
+                                       (object->string c))))
+                         (lambda ()
+                           (primitive-load #$(kexec-loading-program os))
+                           'success)
+                         #:unwind? #t)))))
+    (match result
+      ('success
+       (return #t))
+      (('exception message)
+       (warning (G_ "failed to load operating system for kexec: ~a~%")
+                message)
+       (return #f)))))
 
 
 ;;;