mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-01-31 06:46:50 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

reconfigure: Make ‘load-system-for-kexec’ errors non-fatal.

Browse source 
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
This commit is contained in:
Ludovic Courtès 2025-01-06 13:46:59 +01:00
parent 410a359d4a
commit a6642650a7
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 29 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
guix/scripts/system/reconfigure.scm
View file

@ -230,10 +230,35 @@ (define target-services
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)))))
;;;