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

68
guix/progress.scm
View File

@ -184,44 +184,54 @@ 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?)
(let* ((% (* 100.0 (/ transferred size))) size (not (zero? size))
(throughput (/ transferred elapsed)) transferred)
(left (format #f " ~a ~a" file ;; Display a dot for at most every 10%.
(byte-count->string size))) (when (zero? (modulo (round (* 100. (/ transferred size))) 10))
(right (format #f "~a/s ~a ~a~6,1f%" (display "." log-port)
(byte-count->string throughput) (force-output log-port)))
(seconds->string elapsed) ((and (number? size) (not (zero? size)))
(progress-bar %) %))) (let* ((% (* 100.0 (/ transferred size)))
(erase-current-line log-port) (throughput (/ transferred elapsed))
(display (string-pad-middle left right (left (format #f " ~a ~a" file
(current-terminal-columns)) (byte-count->string size)))
log-port) (right (format #f "~a/s ~a ~a~6,1f%"
(force-output log-port)) (byte-count->string throughput)
;; If we don't know the total size, the last transfer will have a 0B (seconds->string elapsed)
;; size. Don't display it. (progress-bar %) %)))
(unless (zero? transferred) (erase-current-line log-port)
(let* ((throughput (/ transferred elapsed)) (display (string-pad-middle left right
(left (format #f " ~a" file)) (current-terminal-columns))
(right (format #f "~a/s ~a | ~a transferred" log-port)
(byte-count->string throughput) (force-output log-port)))
(seconds->string elapsed) (else
(byte-count->string transferred)))) ;; If we don't know the total size, the last transfer will have a 0B
(erase-current-line log-port) ;; size. Don't display it.
(display (string-pad-middle left right (unless (zero? transferred)
(current-terminal-columns)) (let* ((throughput (/ transferred elapsed))
log-port) (left (format #f " ~a" file))
(force-output log-port))))) (right (format #f "~a/s ~a | ~a transferred"
(byte-count->string throughput)
(seconds->string elapsed)
(byte-count->string transferred))))
(erase-current-line log-port)
(display (string-pad-middle left right
(current-terminal-columns))
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))))))