Toggle quote (33 lines)
> Danny Milosavljevic <dannym@scratchpost.org> skribis:
>
> > * gnu/build/linux-boot.scm (boot-system): Improve error reporting.
> > * gnu/system.scm (operating-system-user-kernel-arguments): Export.
> > * gnu/tests.scm (marionette-operating-system): Modify kernel-arguments.
> > ---
> > gnu/build/linux-boot.scm | 21 ++++++++++++++++++++-
> > gnu/system.scm | 1 +
> > gnu/tests.scm | 3 +++
> > 3 files changed, 24 insertions(+), 1 deletion(-)
> >
> > diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
> > index 4dd740174..bff2eb0f4 100644
> > --- a/gnu/build/linux-boot.scm
> > +++ b/gnu/build/linux-boot.scm
> > @@ -507,7 +507,26 @@ to it are lost."
> > (switch-root "/root")
> > (format #t "loading '~a'...\n" to-load)
> >
> > - (primitive-load to-load)
> > + (catch #t
> > + (lambda ()
> > + (primitive-load to-load))
> > + (lambda (key proc format-string format-args . rest)
> > + (format (current-error-port) "~a: ~a~%" proc
> > + (apply format #f format-string format-args))
> > + (force-output (current-error-port))
> > + (exit 1)
> > + (reboot))
>
> The safe way (an exception could have fewer arguments that what’s above)
> is to write something like:
Toggle diff (150 lines)
diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 4dd740174..92589e667 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -430,7 +430,8 @@ bailing out.~%root contents: ~s~%" (scandir "/"))
qemu-guest-networking?
volatile-root?
pre-mount
- (mounts '()))
+ (mounts '())
+ (enter-repl-on-error? #t))
"This procedure is meant to be called from an initrd. Boot a system by
first loading LINUX-MODULES (a list of module names) from
LINUX-MODULE-DIRECTORY, then setting up QEMU guest networking if
@@ -459,10 +460,28 @@ to it are lost."
(string-append linux-module-directory "/"
(ensure-dot-ko name)))
+ (define (call-with-error-handling* thunk)
+ (if enter-repl-on-error?
+ (call-with-error-handling thunk)
+ (catch #t
+ (call-with-error-handling thunk)
+ (const #t)
+ (lambda (key . args)
+ (let ((print-frames
+ (@@ (system repl debug) print-frames))
+ (frame->stack-vector
+ (@@ (system repl debug) frame->stack-vector))
+ (stack-ref
+ (@@ (system repl debug) stack-ref)))
+ (print-frames
+ (frame->stack-vector
+ (stack-ref (make-stack #t) 0))
+ #:width 1000000)
+ (exit 1))))))
(display "Welcome, this is GNU's early boot Guile.\n")
(display "Use '--repl' for an initrd REPL.\n\n")
- (call-with-error-handling
+ (call-with-error-handling*
(lambda ()
(mount-essential-file-systems)
(let* ((args (linux-command-line))
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index b592defa4..4da219db3 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -155,7 +155,8 @@ MODULES and taken from LINUX."
(mapped-devices '())
(helper-packages '())
qemu-networking?
- volatile-root?)
+ volatile-root?
+ (enter-repl-on-error? #t))
"Return a monadic derivation that builds a raw initrd, with kernel
modules taken from LINUX. FILE-SYSTEMS is a list of file-systems to be
mounted by the initrd, possibly in addition to the root file system specified
@@ -208,6 +209,8 @@ to it are lost."
(set-path-environment-variable "PATH" '("bin" "sbin")
'#$helper-packages)))
+ (display "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX")
+ (display enter-repl-on-error?)
(boot-system #:mounts
(map spec->file-system
'#$(map file-system->spec file-systems))
@@ -216,7 +219,8 @@ to it are lost."
#:linux-modules '#$linux-modules
#:linux-module-directory '#$kodir
#:qemu-guest-networking? #$qemu-networking?
- #:volatile-root? '#$volatile-root?)))
+ #:volatile-root? '#$volatile-root?
+ #:enter-repl-on-error? #$enter-repl-on-error?)))
#:name "raw-initrd"))
(define* (file-system-packages file-systems #:key (volatile-root? #f))
@@ -242,6 +246,7 @@ FILE-SYSTEMS."
(mapped-devices '())
qemu-networking?
volatile-root?
+ (enter-repl-on-error? #t)
(virtio? #t)
(extra-modules '()))
"Return a monadic derivation that builds a generic initrd, with kernel
@@ -312,12 +317,16 @@ loaded at boot time in the order in which they appear."
(define helper-packages
(file-system-packages file-systems #:volatile-root? volatile-root?))
+ (display "YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY")
+ (display enter-repl-on-error?)
+
(raw-initrd file-systems
#:linux linux
#:linux-modules linux-modules
#:mapped-devices mapped-devices
#:helper-packages helper-packages
#:qemu-networking? qemu-networking?
- #:volatile-root? volatile-root?))
+ #:volatile-root? volatile-root?
+ #:enter-repl-on-error? enter-repl-on-error?))
;;; linux-initrd.scm ends here
diff --git a/gnu/tests.scm b/gnu/tests.scm
index 0caa922fd..1853bc269 100644
--- a/gnu/tests.scm
+++ b/gnu/tests.scm
@@ -172,6 +172,10 @@ marionette service in the guest is started after the Shepherd services listed
in REQUIREMENTS."
(operating-system
(inherit os)
+ (initrd (lambda (fs . rest)
+ (apply (operating-system-initrd os) fs
+ #:enter-repl-on-error? #f
+ rest)))
(services (cons (service marionette-service-type
(marionette-configuration
(requirements requirements)
But I get a resolve-variable error about enter-repl-on-error. Why?
> > --- a/gnu/system.scm
> > +++ b/gnu/system.scm
> > @@ -73,6 +73,7 @@
> > operating-system-hosts-file
> > operating-system-kernel
> > operating-system-kernel-file
> > + operating-system-user-kernel-arguments
> > operating-system-kernel-arguments
> > operating-system-initrd
> > operating-system-users
> > diff --git a/gnu/tests.scm b/gnu/tests.scm
> > index 0caa922fd..dc0188f1e 100644
> > --- a/gnu/tests.scm
> > +++ b/gnu/tests.scm
> > @@ -172,6 +172,9 @@ marionette service in the guest is started after the Shepherd services listed
> > in REQUIREMENTS."
> > (operating-system
> > (inherit os)
> > + ;; Make sure that the system doesn't hang on kernel panic.
> > + (kernel-arguments (cons "panic=1"
> > + (operating-system-user-kernel-arguments os)))
> > (services (cons (service marionette-service-type
> > (marionette-configuration
> > (requirements requirements)
>
> That’s a good idea. Could you make it a separate commit?
Sure, okay.