bug#58375: Installer does not show what is being downloaded

[Mathieu Othacehe <othacehe@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 1222 bytes --]


Hey,

> If we really want to capture the output of ‘guix system init’, then we
> need to open a pseudo-terminal with ‘openpty’ & co. instead of ‘pipe’ in
> ‘run-external-command-with-handler’.  That may be relatively easy
> actually.

So I implemented your proposal. It seems to be working quite well. As
discussed on #guix, we could avoid to dump the download bars to the
syslog if the "guix system init" command succeeds. However, it seems
quite tricky in the current implementation where the syslog dumping is
actually a hook (%syslog-line-hook).

Fixing this issue, I also realized that when the "guix system init"
command fails, the user is only offered to resume the installation or
restart it.

In cases where "guix system init" failed because of a network issue, or
because a partition was too small, restarting/resuming seems like the
right thing to do.

However, when the installer failed because "guix system init" crashed or
segfaulted, restarting/resuming won't probably help, and dumping the
crash is probably the best way to get help. That's why I added in a
second patch, a new button "Report the failure" to the
"run-install-failed-page".

Thanks,

Mathieu

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-installer-Run-the-guix-system-init-command-in-a-PTY.patch --]
[-- Type: text/x-patch, Size: 5054 bytes --]

From c6286404e9c4c0dc302c3d398a8f27b050cf4ce0 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <othacehe@gnu.org>
Date: Fri, 14 Oct 2022 17:28:27 +0200
Subject: [PATCH 1/2] installer: Run the "guix system init" command in a PTY.

Fixes: <https://issues.guix.gnu.org/55360>

* gnu/installer/utils.scm (run-external-command-with-handler/tty): New
procedure.
(run-external-command-with-line-hooks, run-command): Add a TTY? argument.
* gnu/installer/final.scm (install-system): Call run-command with TTY?
argument set to #true.
---
 gnu/installer/final.scm |  2 +-
 gnu/installer/utils.scm | 50 +++++++++++++++++++++++++++++++++--------
 2 files changed, 42 insertions(+), 10 deletions(-)

diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm
index 3f6dacc490..044f79372b 100644
--- a/gnu/installer/final.scm
+++ b/gnu/installer/final.scm
@@ -211,7 +211,7 @@ (define (assert-exit x)
 
              (setenv "PATH" "/run/current-system/profile/bin/")
 
-             (set! ret (run-command install-command)))
+             (set! ret (run-command install-command #:tty? #t)))
            (lambda ()
              ;; Restart guix-daemon so that it does no keep the MNT namespace
              ;; alive.
diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm
index 5fd2e2d425..061493e6a7 100644
--- a/gnu/installer/utils.scm
+++ b/gnu/installer/utils.scm
@@ -20,6 +20,7 @@
 (define-module (gnu installer utils)
   #:use-module (gnu services herd)
   #:use-module (guix utils)
+  #:use-module ((guix build syscalls) #:select (openpty login-tty))
   #:use-module (guix build utils)
   #:use-module (guix i18n)
   #:use-module (srfi srfi-1)
@@ -45,6 +46,7 @@ (define-module (gnu installer utils)
             nearest-exact-integer
             read-percentage
             run-external-command-with-handler
+            run-external-command-with-handler/tty
             run-external-command-with-line-hooks
             run-command
             run-command-in-installer
@@ -124,10 +126,37 @@ (define dummy-pipe
     (close-port input)
     (close-pipe dummy-pipe)))
 
-(define (run-external-command-with-line-hooks line-hooks command)
+(define (run-external-command-with-handler/tty handler command)
+  "Run command specified by the list COMMAND in a child operating in a
+pseudoterminal with output handler HANDLER.  HANDLER is a procedure taking an
+input port, to which the command will write its standard output and error.
+Returns the integer status value of the child process as returned by waitpid."
+  (define-values (controller inferior)
+    (openpty))
+
+  (match (primitive-fork)
+    (0
+     (catch #t
+       (lambda ()
+         (close-fdes controller)
+         (login-tty inferior)
+         (apply execlp (car command) command))
+       (lambda _
+         (primitive-exit 127))))
+    (pid
+     (close-fdes inferior)
+     (let* ((port (fdopen controller "r0"))
+            (result (false-if-exception
+                     (handler port))))
+       (close-port port)
+       (cdr (waitpid pid))))))
+
+(define* (run-external-command-with-line-hooks line-hooks command
+                                               #:key (tty? #false))
   "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."
+output line with the procedures in LINE-HOOKS.  If TTY is set to #true, the
+COMMAND will be run in a pseudoterminal.  Returns the integer status value of
+the child process as returned by waitpid."
   (define (handler input)
     (and
      (and=> (get-line input)
@@ -136,14 +165,17 @@ (define (handler input)
                   #f
                   (begin (for-each (lambda (f) (f line))
                                    (append line-hooks
-                                       %default-installer-line-hooks))
+                                           %default-installer-line-hooks))
                          #t))))
      (handler input)))
-  (run-external-command-with-handler handler command))
+  (if tty?
+      (run-external-command-with-handler/tty handler command)
+      (run-external-command-with-handler handler command)))
 
-(define* (run-command command)
+(define* (run-command command #:key (tty? #f))
   "Run COMMAND, a list of strings.  Return true if COMMAND exited
-successfully, #f otherwise."
+successfully, #f otherwise.  If TTY is set to #true, the COMMAND will be run
+in a pseudoterminal."
   (define (pause)
     (format #t (G_ "Press Enter to continue.~%"))
     (send-to-clients '(pause))
@@ -154,8 +186,8 @@ (define (pause)
 
   (installer-log-line "running command ~s" command)
   (define result (run-external-command-with-line-hooks
-                  (list %display-line-hook)
-                  command))
+                  (list %display-line-hook) command
+                  #:tty? tty?))
   (define exit-val (status:exit-val result))
   (define term-sig (status:term-sig result))
   (define stop-sig (status:stop-sig result))
-- 
2.37.3


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-installer-Propose-the-user-to-report-a-guix-system-i.patch --]
[-- Type: text/x-patch, Size: 1426 bytes --]

From 159b82a013cad8c3c698031cce9ee07956153da3 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <othacehe@gnu.org>
Date: Fri, 14 Oct 2022 17:33:28 +0200
Subject: [PATCH 2/2] installer: Propose the user to report a "guix system
 init" failure.

* gnu/installer/newt/final.scm (run-install-failed-page): Add a "Report the
failure" button.
---
 gnu/installer/newt/final.scm | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm
index 7c3f73ee82..6e55be5067 100644
--- a/gnu/installer/newt/final.scm
+++ b/gnu/installer/newt/final.scm
@@ -80,16 +80,21 @@ (define (run-install-success-page)
 (define (run-install-failed-page)
   (match (current-clients)
     (()
-     (match (choice-window
+     (match (ternary-window
              (G_ "Installation failed")
              (G_ "Resume")
              (G_ "Restart the installer")
+             (G_ "Report the failure")
              (G_ "The final system installation step failed.  You can resume from \
 a specific step, or restart the installer."))
        (1 (abort-to-prompt 'installer-step 'abort))
        (2
         ;; Keep going, the installer will be restarted later on.
-        #t)))
+        #t)
+       (3 (raise
+           (condition
+            (&message
+             (message "User abort.")))))))
     (_
      (send-to-clients '(installation-failure))
      #t)))
-- 
2.37.3