[bug#53063] [PATCH wip-harden-installer 00/14] General improvements to the installer

[Mathieu Othacehe <othacehe@gnu.org>]

Hey Josselin,

Great work!

> It expands upon the initial work of Mathieu in 84d0d8ad3d.  For now,
> you can choose to include the installer backtrace, the installer
> result alist, and the syslog and dmesg.  We could also include a more
> stripped down installer-log that the new logging facility produces,
> but I think that it should be enough for now.

I tweaked this commit a little bit to add an horizontal left anchor.

> Things work smoothly on my end, but the installer test
> "gui-installed-os" seems to fail while running `guix system init`,
> when building linux-libre, but it seems unrelated to this patchset.

Things works really fine here too, I pushed the series on the
wip-harden-installer to have Cuirass run the installer tests.

Here are the few modifications I made:

--8<---------------cut here---------------start------------->8---
diff --git a/gnu/installer.scm b/gnu/installer.scm
index 01eda04774..7b2914be98 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -420,7 +420,6 @@ (define steps (#$steps current-installer))
 
             (dynamic-wind
               (installer-init current-installer)
-              
               (lambda ()
                 (parameterize
                     ((run-command-in-installer
@@ -439,15 +438,15 @@ (define results
                          (sync)
                          (stop-service 'root))
                         (_
-                         ;; The installation failed, exit so that it is restarted
-                         ;; by login.
+                         ;; The installation failed, exit so that it is
+                         ;; restarted by login.
                          #f)))
                     (const #f)
                     (lambda (key . args)
                       (installer-log-line "crashing due to uncaught exception: ~s ~s"
                                           key args)
-                      (define dump-dir (prepare-dump key args
-                                                     #:result %current-result))
+                      (define dump-dir
+                        (prepare-dump key args #:result %current-result))
                       (define action
                         ((installer-exit-error current-installer)
                          (get-string-all
@@ -458,7 +457,8 @@ (define action
                          (let* ((dump-files
                                  ((installer-dump-page current-installer)
                                   dump-dir))
-                                (dump-archive (make-dump dump-dir dump-files)))
+                                (dump-archive
+                                 (make-dump dump-dir dump-files)))
                            ((installer-report-page current-installer)
                             dump-archive)))
                         (_ #f))
diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm
index 2646b5d369..1db78e6f0d 100644
--- a/gnu/installer/newt.scm
+++ b/gnu/installer/newt.scm
@@ -45,6 +45,7 @@ (define-module (gnu installer newt)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (ice-9 ftw)
+  #:use-module (ice-9 match)
   #:use-module (newt)
   #:export (newt-installer))
 
@@ -71,8 +72,8 @@ (define action
      #:content error
      #:buttons-spec
      (list
-      (cons (G_ "Exit") (const 'exit))
-      (cons (G_ "Dump") (const 'dump)))))
+      (cons (G_ "Dump") (const 'dump))
+      (cons (G_ "Exit") (const 'exit)))))
   (newt-set-color COLORSET-ROOT "white" "blue")
   action)
 
@@ -96,10 +97,11 @@ (define files
     (scandir dump-dir (lambda (x)
                         (not (or (string=? x ".")
                                  (string=? x ".."))))))
-  (fold (lambda (file-choice acc)
-          (if (cdr file-choice)
-              (cons (car file-choice) acc)
-              acc))
+  (fold (match-lambda*
+          (((file . enable?) acc)
+           (if enable?
+               (cons file acc)
+               acc)))
         '()
         (run-dump-page
          dump-dir
@@ -144,7 +146,7 @@ (define stop-sig (status:stop-sig result))
                            (cons "Abort"
                                  (lambda ()
                                    (abort-to-prompt 'installer-step 'abort)))
-                           (cons "Dump"
+                           (cons "Report"
                                  (lambda ()
                                    (raise
                                     (condition
diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm
index 060e633254..0f508a31c0 100644
--- a/gnu/installer/newt/page.scm
+++ b/gnu/installer/newt/page.scm
@@ -910,22 +910,29 @@ (define info-textbox
   (define components
     (map (match-lambda ((file . enabled)
                         (list
-                         (make-button -1 -1 "Edit")
+                         (make-compact-button -1 -1 "Edit")
                          (make-checkbox -1 -1 file (if enabled #\x #\ ) " x")
                          file)))
          file-choices))
+
+  (define sub-grid (make-grid 2 (length components)))
+
+  (for-each
+   (match-lambda* (((button checkbox _) index)
+                   (set-grid-field sub-grid 0 index
+                                   GRID-ELEMENT-COMPONENT checkbox
+                                   #:anchor ANCHOR-LEFT)
+                   (set-grid-field sub-grid 1 index
+                                   GRID-ELEMENT-COMPONENT button
+                                   #:anchor ANCHOR-LEFT)))
+   components (iota (length components)))
+
   (define grid
-    (apply vertically-stacked-grid
+    (vertically-stacked-grid
      GRID-ELEMENT-COMPONENT info-textbox
-     (append
-         (append-map
-          (match-lambda ((button checkbox _)
-                         (list GRID-ELEMENT-SUBGRID
-                               (horizontal-stacked-grid
-                                GRID-ELEMENT-COMPONENT checkbox
-                                GRID-ELEMENT-COMPONENT button))))
-          components)
-         (list GRID-ELEMENT-COMPONENT (make-button -1 -1 "Create")))))
+     GRID-ELEMENT-SUBGRID sub-grid
+     GRID-ELEMENT-COMPONENT (make-button -1 -1 "Create")))
+
   (define form (make-form #:flags FLAG-NOF12))
 
   (add-form-to-grid grid form #t)
@@ -942,13 +949,13 @@ (define prompt-tag (make-prompt-tag))
           (match exit-reason
             ('exit-component
              (let ((result
-               (map (match-lambda
-                      ((edit checkbox filename)
-                       (if (components=? edit argument)
-                           (abort-to-prompt prompt-tag filename)
-                           (cons filename (eq? #\x
-                                               (checkbox-value checkbox))))))
-                    components)))
+                    (map (match-lambda
+                           ((edit checkbox filename)
+                            (if (components=? edit argument)
+                                (abort-to-prompt prompt-tag filename)
+                                (cons filename (eq? #\x
+                                                    (checkbox-value checkbox))))))
+                         components)))
                (destroy-form-and-pop form)
                result))
             ;; TODO
diff --git a/gnu/installer/user.scm b/gnu/installer/user.scm
index 13114e9832..c894a91dc8 100644
--- a/gnu/installer/user.scm
+++ b/gnu/installer/user.scm
@@ -41,6 +41,7 @@ (define-record-type <secret>
   (make-secret content)
   secret?
   (content secret-content))
+
 (set-record-type-printer!
  <secret>
  (lambda (secret port)
diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm
index 4f7c691690..fb62fb8896 100644
--- a/gnu/installer/utils.scm
+++ b/gnu/installer/utils.scm
@@ -108,19 +108,20 @@ (define dummy-pipe
     (close-pipe dummy-pipe)))
 
 (define (run-external-command-with-line-hooks line-hooks command)
-  "Run command specified by ARGS in a child, processing each output line with
-the procedures in LINE-HOOKS.  Returns the integer status value of
-the child process as returned by waitpid."
+  "Run command specified by the list COMMAND in a child, processing each
+output line with the procedures in LINE-HOOKS.  Returns the integer status
+value of the child process as returned by waitpid."
   (define (handler input)
-    (and (and=> (get-line input)
-                (lambda (line)
-                  (if (eof-object? line)
-                      #f
-                      (begin (for-each (lambda (f) (f line))
-                                (append line-hooks
-                                    %default-installer-line-hooks))
-                             #t))))
-         (handler input)))
+    (and
+     (and=> (get-line input)
+            (lambda (line)
+              (if (eof-object? line)
+                  #f
+                  (begin (for-each (lambda (f) (f line))
+                                   (append line-hooks
+                                       %default-installer-line-hooks))
+                         #t))))
+     (handler input)))
   (run-external-command-with-handler handler command))
 
 (define* (run-command command)--8
 <---------------cut here---------------end--------------->8---

If it's OK for you, I think we can proceed as the concerns that Ludo
raised on the dump mechanism are addressed. Ludo do you agree?
 
Thanks,

Mathieu