[bug#29922] [PATCH v2] linux-boot: Improve error reporting.

[Danny Milosavljevic <dannym@scratchpost.org>]

Hi Ludo,

On Mon, 08 Jan 2018 10:05:10 +0100
ludo@gnu.org (Ludovic Courtès) wrote:
> 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:

I think it's better if, instead, we give the initrd (at least) a new parameter enter-repl-on-errors?, defaulting to #t, which can be used by marionette-operating-system to disable the REPL.

I tried to do that like this:

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.