[bug#75402] [PATCH 3/3] reconfigure: Make ‘load-system-for-kexec’ errors non-fatal.

["Ludovic Courtès" <ludo@gnu.org>]

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 @@ (define* (upgrade-shepherd-services eval 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)))))
 
 \f
 ;;;
-- 
2.47.1