linux-initrd: Use 'call-with-error-handling' when booting.
* guix/build/linux-initrd.scm (canonicalize-device-spec): When label resolution fails, call 'error' instead of 'format' + 'start-repl'. (boot-system): Wrap most of body in 'call-with-error-handling'. Remove 'catch' around 'primitive-load' call.
This commit is contained in:
parent
dccab4df20
commit
e3ced65af0
|
@ -20,6 +20,7 @@
|
||||||
#:use-module (rnrs io ports)
|
#:use-module (rnrs io ports)
|
||||||
#:use-module (rnrs bytevectors)
|
#:use-module (rnrs bytevectors)
|
||||||
#:use-module (system foreign)
|
#:use-module (system foreign)
|
||||||
|
#:use-module (system repl error-handling)
|
||||||
#:autoload (system repl repl) (start-repl)
|
#:autoload (system repl repl) (start-repl)
|
||||||
#:autoload (system base compile) (compile-file)
|
#:autoload (system base compile) (compile-file)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
|
@ -250,10 +251,7 @@ the following:
|
||||||
;; Some devices take a bit of time to appear, most notably USB
|
;; Some devices take a bit of time to appear, most notably USB
|
||||||
;; storage devices. Thus, wait for the device to appear.
|
;; storage devices. Thus, wait for the device to appear.
|
||||||
(if (> count max-trials)
|
(if (> count max-trials)
|
||||||
(begin
|
(error "failed to resolve partition label" spec)
|
||||||
(format (current-error-port)
|
|
||||||
"failed to resolve partition label: ~s~%" spec)
|
|
||||||
(start-repl))
|
|
||||||
(begin
|
(begin
|
||||||
(sleep 1)
|
(sleep 1)
|
||||||
(loop (+ 1 count))))))))
|
(loop (+ 1 count))))))))
|
||||||
|
@ -615,6 +613,8 @@ to it are lost."
|
||||||
(display "Welcome, this is GNU's early boot Guile.\n")
|
(display "Welcome, this is GNU's early boot Guile.\n")
|
||||||
(display "Use '--repl' for an initrd REPL.\n\n")
|
(display "Use '--repl' for an initrd REPL.\n\n")
|
||||||
|
|
||||||
|
(call-with-error-handling
|
||||||
|
(lambda ()
|
||||||
(mount-essential-file-systems)
|
(mount-essential-file-systems)
|
||||||
(let* ((args (linux-command-line))
|
(let* ((args (linux-command-line))
|
||||||
(to-load (find-long-option "--load" args))
|
(to-load (find-long-option "--load" args))
|
||||||
|
@ -676,15 +676,8 @@ to it are lost."
|
||||||
(mount "none" "/dev/pts" "devpts")
|
(mount "none" "/dev/pts" "devpts")
|
||||||
|
|
||||||
;; TODO: Remove /lib, /share, and /loader.go.
|
;; TODO: Remove /lib, /share, and /loader.go.
|
||||||
(catch #t
|
(primitive-load to-load)
|
||||||
(lambda ()
|
|
||||||
(primitive-load to-load))
|
|
||||||
(lambda args
|
|
||||||
(start-repl))
|
|
||||||
(lambda args
|
|
||||||
(format (current-error-port) "'~a' raised an exception: ~s~%"
|
|
||||||
to-load args)
|
|
||||||
(display-backtrace (make-stack #t) (current-error-port))))
|
|
||||||
(format (current-error-port)
|
(format (current-error-port)
|
||||||
"boot program '~a' terminated, rebooting~%"
|
"boot program '~a' terminated, rebooting~%"
|
||||||
to-load)
|
to-load)
|
||||||
|
@ -693,6 +686,6 @@ to it are lost."
|
||||||
(begin
|
(begin
|
||||||
(display "no boot file passed via '--load'\n")
|
(display "no boot file passed via '--load'\n")
|
||||||
(display "entering a warm and cozy REPL\n")
|
(display "entering a warm and cozy REPL\n")
|
||||||
(start-repl)))))
|
(start-repl)))))))
|
||||||
|
|
||||||
;;; linux-initrd.scm ends here
|
;;; linux-initrd.scm ends here
|
||||||
|
|
Loading…
Reference in New Issue