installer: Print progress bars and such as soon as \r is read.
Fixes <https://issues.guix.gnu.org/59922>. Previously progress bars and related things would be buffered by 'run-external-command-with-line-hooks' until \n is read. * gnu/installer/utils.scm (run-external-command-with-line-hooks): Use 'read-delimited' rather than 'get-line'. Pass 'concat as the last argument. (%display-line-hook): Remove. (run-command): Use 'display' instead of '%display-line-hook'. (%syslog-line-hook): Add "\n" when LINE doesn't end in \n. (%installer-log-line-hook): Do not add an extra newline. (installer-log-line): Add an extra newline.master
parent
556520a33c
commit
591af24ade
|
@ -116,7 +116,7 @@ report it by email to ~a.") uploaded-name %guix-bug-report-address)
|
||||||
(define command-output "")
|
(define command-output "")
|
||||||
(define (line-accumulator line)
|
(define (line-accumulator line)
|
||||||
(set! command-output
|
(set! command-output
|
||||||
(string-append/shared command-output line "\n")))
|
(string-append/shared command-output line)))
|
||||||
(define result (run-external-command-with-line-hooks (list line-accumulator)
|
(define result (run-external-command-with-line-hooks (list line-accumulator)
|
||||||
args))
|
args))
|
||||||
(define exit-val (status:exit-val result))
|
(define exit-val (status:exit-val result))
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
|
;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
|
||||||
;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -159,7 +159,9 @@ COMMAND will be run in a pseudoterminal. Returns the integer status value of
|
||||||
the child process as returned by waitpid."
|
the child process as returned by waitpid."
|
||||||
(define (handler input)
|
(define (handler input)
|
||||||
(and
|
(and
|
||||||
(and=> (get-line input)
|
;; Lines for progress bars etc. end in \r; treat is as a line ending so
|
||||||
|
;; those lines are printed right away.
|
||||||
|
(and=> (read-delimited "\r\n" input 'concat)
|
||||||
(lambda (line)
|
(lambda (line)
|
||||||
(if (eof-object? line)
|
(if (eof-object? line)
|
||||||
#f
|
#f
|
||||||
|
@ -186,7 +188,7 @@ in a pseudoterminal."
|
||||||
|
|
||||||
(installer-log-line "running command ~s" command)
|
(installer-log-line "running command ~s" command)
|
||||||
(define result (run-external-command-with-line-hooks
|
(define result (run-external-command-with-line-hooks
|
||||||
(list %display-line-hook) command
|
(list display) command
|
||||||
#:tty? tty?))
|
#:tty? tty?))
|
||||||
(define exit-val (status:exit-val result))
|
(define exit-val (status:exit-val result))
|
||||||
(define term-sig (status:term-sig result))
|
(define term-sig (status:term-sig result))
|
||||||
|
@ -264,7 +266,10 @@ values."
|
||||||
(or port (%make-void-port "w")))))
|
(or port (%make-void-port "w")))))
|
||||||
|
|
||||||
(define (%syslog-line-hook line)
|
(define (%syslog-line-hook line)
|
||||||
(format (syslog-port) "installer[~d]: ~a~%" (getpid) line))
|
(let ((line (if (string-suffix? "\r" line)
|
||||||
|
(string-append (string-drop-right line 1) "\n")
|
||||||
|
line)))
|
||||||
|
(format (syslog-port) "installer[~d]: ~a" (getpid) line)))
|
||||||
|
|
||||||
(define-syntax syslog
|
(define-syntax syslog
|
||||||
(lambda (s)
|
(lambda (s)
|
||||||
|
@ -293,11 +298,7 @@ values."
|
||||||
port)))
|
port)))
|
||||||
|
|
||||||
(define (%installer-log-line-hook line)
|
(define (%installer-log-line-hook line)
|
||||||
(format (installer-log-port) "~a~%" line))
|
(display line (installer-log-port)))
|
||||||
|
|
||||||
(define (%display-line-hook line)
|
|
||||||
(display line)
|
|
||||||
(newline))
|
|
||||||
|
|
||||||
(define %default-installer-line-hooks
|
(define %default-installer-line-hooks
|
||||||
(list %syslog-line-hook
|
(list %syslog-line-hook
|
||||||
|
@ -309,9 +310,10 @@ values."
|
||||||
(syntax-case s ()
|
(syntax-case s ()
|
||||||
((_ fmt args ...)
|
((_ fmt args ...)
|
||||||
(string? (syntax->datum #'fmt))
|
(string? (syntax->datum #'fmt))
|
||||||
#'(let ((formatted (format #f fmt args ...)))
|
(with-syntax ((fmt (string-append (syntax->datum #'fmt) "\n")))
|
||||||
(for-each (lambda (f) (f formatted))
|
#'(let ((formatted (format #f fmt args ...)))
|
||||||
%default-installer-line-hooks))))))
|
(for-each (lambda (f) (f formatted))
|
||||||
|
%default-installer-line-hooks)))))))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
|
Reference in New Issue