[bug#53063] [PATCH v2 wip-harden-installer 07/18] installer: Capture external commands output.

[Josselin Poiret via Guix-patches via <guix-patches@gnu.org>]

* gnu/installer/utils.scm (run-external-command-with-handler,
run-external-command-with-line-hooks): New variables.
(run-command): Use run-external-command-with-line-hooks.
---
 gnu/installer/utils.scm | 97 ++++++++++++++++++++++++++++++++---------
 1 file changed, 77 insertions(+), 20 deletions(-)

diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm
index 1bff1e1229..9cfff0054b 100644
--- a/gnu/installer/utils.scm
+++ b/gnu/installer/utils.scm
@@ -25,7 +25,9 @@ (define-module (gnu installer utils)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-34)
+  #:use-module (ice-9 control)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 popen)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 format)
@@ -34,6 +36,8 @@ (define-module (gnu installer utils)
             read-all
             nearest-exact-integer
             read-percentage
+            run-external-command-with-handler
+            run-external-command-with-line-hooks
             run-command
 
             syslog-port
@@ -78,37 +82,90 @@ (define (read-percentage percentage)
     (and result
          (string->number (match:substring result 1)))))
 
+(define* (run-external-command-with-handler handler command)
+  "Run command specified by the list COMMAND in a child 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."
+  (match-let (((input . output) (pipe)))
+    ;; Hack to work around Guile bug 52835
+    (define dup-output (duplicate-port output "w"))
+    ;; Void pipe, but holds the pid for close-pipe.
+    (define dummy-pipe
+      (with-input-from-file "/dev/null"
+        (lambda ()
+          (with-output-to-port output
+            (lambda ()
+              (with-error-to-port dup-output
+                (lambda ()
+                  (apply open-pipe* (cons "" command)))))))))
+    (close-port output)
+    (close-port dup-output)
+    (handler input)
+    (close-port input)
+    (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."
+  (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)))
+  (run-external-command-with-handler handler command))
+
 (define* (run-command command)
   "Run COMMAND, a list of strings.  Return true if COMMAND exited
 successfully, #f otherwise."
-  (define env (environ))
-
   (define (pause)
     (format #t (G_ "Press Enter to continue.~%"))
     (send-to-clients '(pause))
-    (environ env)                               ;restore environment variables
     (match (select (cons (current-input-port) (current-clients))
              '() '())
       (((port _ ...) _ _)
        (read-line port))))
 
-  (setenv "PATH" "/run/current-system/profile/bin")
-
-  (guard (c ((invoke-error? c)
-             (newline)
-             (format (current-error-port)
-                     (G_ "Command failed with exit code ~a.~%")
-                     (invoke-error-exit-status c))
-             (installer-log-line "command ~s failed with exit code ~a"
-                                 command (invoke-error-exit-status c))
-             (pause)
-             #f))
-    (installer-log-line "running command ~s" command)
-    (apply invoke command)
-    (installer-log-line "command ~s succeeded" command)
-    (newline)
-    (pause)
-    #t))
+  (installer-log-line "running command ~s" command)
+  (define result (run-external-command-with-line-hooks
+                  (list %display-line-hook)
+                  command))
+  (define exit-val (status:exit-val result))
+  (define term-sig (status:term-sig result))
+  (define stop-sig (status:stop-sig result))
+  (define succeeded?
+    (cond
+     ((and exit-val (not (zero? exit-val)))
+      (installer-log-line "command ~s exited with value ~a"
+                          command exit-val)
+      (format #t (G_ "Command ~s exited with value ~a")
+              command exit-val)
+      #f)
+     (term-sig
+      (installer-log-line "command ~s killed by signal ~a"
+                          command term-sig)
+      (format #t (G_ "Command ~s killed by signal ~a")
+              command term-sig)
+      #f)
+     (stop-sig
+      (installer-log-line "command ~s stopped by signal ~a"
+                          command stop-sig)
+      (format #t (G_ "Command ~s stopped by signal ~a")
+              command stop-sig)
+      #f)
+     (else
+      (installer-log-line "command ~s succeeded" command)
+      (format #t (G_ "Command ~s succeeded") command)
+      #t)))
+  (newline)
+  (pause)
+  succeeded?)
 
 \f
 ;;;
-- 
2.34.0