guix
/
guix
mirror of git://git.savannah.gnu.org/guix.git
3
4
Fork 0
Code Issues Releases Wiki Activity

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'.
This commit is contained in:
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
#:key
(tty? #t)
start-time (transferred 0)
(log-port (current-error-port)))
"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
throughput."
throughput. When TTY? is false, assume LOG-PORT is not a tty and do not emit
ANSI escape codes."
(define elapsed
(duration->seconds
(time-difference (current-time (time-type start-time))
start-time)))
(if (and (number? size) (not (zero? size)))
(let* ((% (* 100.0 (/ transferred size)))
(throughput (/ transferred elapsed))
(left (format #f " ~a ~a" file
(byte-count->string size)))
(right (format #f "~a/s ~a ~a~6,1f%"
(byte-count->string throughput)
(seconds->string elapsed)
(progress-bar %) %)))
(erase-current-line log-port)
(display (string-pad-middle left right
(current-terminal-columns))
log-port)
(force-output log-port))
;; If we don't know the total size, the last transfer will have a 0B
;; size. Don't display it.
(unless (zero? transferred)
(let* ((throughput (/ transferred elapsed))
(left (format #f " ~a" file))
(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)))))
(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)))
(throughput (/ transferred elapsed))
(left (format #f " ~a ~a" file
(byte-count->string size)))
(right (format #f "~a/s ~a ~a~6,1f%"
(byte-count->string throughput)
(seconds->string elapsed)
(progress-bar %) %)))
(erase-current-line log-port)
(display (string-pad-middle left right
(current-terminal-columns))
log-port)
(force-output log-port)))
(else
;; If we don't know the total size, the last transfer will have a 0B
;; size. Don't display it.
(unless (zero? transferred)
(let* ((throughput (/ transferred elapsed))
(left (format #f " ~a" file))
(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
;; 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))
identity))
(define tty?
(isatty?* port))
(define (report-build-progress phase %)
(let ((% (min (max % 0) 100))) ;sanitize
(erase-current-line port)
@ -542,6 +545,7 @@ addition to build events."
(nar-uri-abbreviation uri)
(basename uri))))
(display-download-progress uri size
#:tty? tty?
#:start-time
(download-start download)
#:transferred transferred))))))