me
/
guix
Archived
1
0
Fork 0
Code

status: Do not emit ANSI escapes when stderr is not a tty. 

Fixes <https://bugs.gnu.org/44985>.
Reported by Simon Josefsson <simon@josefsson.org>.

* guix/progress.scm (display-download-progress): Add #:tty? and honor it.
* guix/status.scm (print-build-event): Pass #:tty? to
'display-download-progress'.
master
Ludovic Courtès 2020-12-17 17:26:19 +01:00
parent e5bbb4662f
commit d613c1771a
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 43 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
guix/progress.scm
View File

@ -184,17 +184,26 @@ move the cursor to the beginning of the line."
(define* (display-download-progress file size (define* (display-download-progress file size
#:key #:key
(tty? #t)
start-time (transferred 0) start-time (transferred 0)
(log-port (current-error-port))) (log-port (current-error-port)))
"Write the progress report to LOG-PORT. Use START-TIME (a SRFI-19 time "Write the progress report to LOG-PORT. Use START-TIME (a SRFI-19 time
object) and TRANSFERRED (a total number of bytes) to determine the object) and TRANSFERRED (a total number of bytes) to determine the
throughput." throughput. When TTY? is false, assume LOG-PORT is not a tty and do not emit
ANSI escape codes."
(define elapsed (define elapsed
(duration->seconds (duration->seconds
(time-difference (current-time (time-type start-time)) (time-difference (current-time (time-type start-time))
start-time))) start-time)))
(if (and (number? size) (not (zero? size))) (cond ((and (not tty?)
size (not (zero? size))
transferred)
;; Display a dot for at most every 10%.
(when (zero? (modulo (round (* 100. (/ transferred size))) 10))
(display "." log-port)
(force-output log-port)))
((and (number? size) (not (zero? size)))
(let* ((% (* 100.0 (/ transferred size))) (let* ((% (* 100.0 (/ transferred size)))
(throughput (/ transferred elapsed)) (throughput (/ transferred elapsed))
(left (format #f " ~a ~a" file (left (format #f " ~a ~a" file
@ -207,7 +216,8 @@ throughput."
(display (string-pad-middle left right (display (string-pad-middle left right
(current-terminal-columns)) (current-terminal-columns))
log-port) log-port)
(force-output log-port)) (force-output log-port)))
(else
;; If we don't know the total size, the last transfer will have a 0B ;; If we don't know the total size, the last transfer will have a 0B
;; size. Don't display it. ;; size. Don't display it.
(unless (zero? transferred) (unless (zero? transferred)
@ -221,7 +231,7 @@ throughput."
(display (string-pad-middle left right (display (string-pad-middle left right
(current-terminal-columns)) (current-terminal-columns))
log-port) log-port)
(force-output log-port))))) (force-output log-port))))))
(define %progress-interval (define %progress-interval
;; Default interval between subsequent outputs for rate-limited displays. ;; Default interval between subsequent outputs for rate-limited displays.

4
guix/status.scm
View File

@ -423,6 +423,9 @@ addition to build events."
(cute colorize-string <> (color RED BOLD)) (cute colorize-string <> (color RED BOLD))
identity)) identity))
(define tty?
(isatty?* port))
(define (report-build-progress phase %) (define (report-build-progress phase %)
(let ((% (min (max % 0) 100))) ;sanitize (let ((% (min (max % 0) 100))) ;sanitize
(erase-current-line port) (erase-current-line port)
@ -542,6 +545,7 @@ addition to build events."
(nar-uri-abbreviation uri) (nar-uri-abbreviation uri)
(basename uri)))) (basename uri))))
(display-download-progress uri size (display-download-progress uri size
#:tty? tty?
#:start-time #:start-time
(download-start download) (download-start download)
#:transferred transferred)))))) #:transferred transferred))))))