me
/
guix
Archived
1
0
Fork 0

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
Ludovic Courtès 2022-12-09 17:47:08 +01:00
parent 556520a33c
commit 591af24ade
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 15 additions and 13 deletions

View File

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

View File

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