08/20: installer: Capture external commands output.

[guix-commits]

mothacehe pushed a commit to branch master
in repository guix.

commit 0b9fbbb4dd24f227c9a708561ba291f6169ad2e6
Author: Josselin Poiret <dev@jpoiret.xyz>
AuthorDate: Sat Jan 15 14:50:00 2022 +0100

    installer: Capture external commands output.
    
    * 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.
    
    Signed-off-by: Mathieu Othacehe <othacehe@gnu.org>
---
 gnu/installer/utils.scm | 98 +++++++++++++++++++++++++++++++++++++++----------
 1 file changed, 78 insertions(+), 20 deletions(-)

diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm
index 1bff1e1229..66c41ac2a1 100644
--- a/gnu/installer/utils.scm
+++ b/gnu/installer/utils.scm
@@ -25,7 +25,9 @@
   #: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 @@
             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,91 @@ number. If no percentage is found, return #f"
     (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 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)))
+  (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?)
 
 
 ;;;