@@ -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?)
;;;