TakeV/guix
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

installer: Capture external commands output.

Browse source 
* 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>
This commit is contained in:
Josselin Poiret 2022-01-15 14:50:00 +01:00 committed by Mathieu Othacehe
parent c57ec6ed1e
commit 0b9fbbb4dd
No known key found for this signature in database
GPG key ID: 8354763531769CA6
1 changed files with 78 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

98
gnu/installer/utils.scm
View file

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