diff options
author | Ludovic Courtès <ludo@gnu.org> | 2020-12-17 17:26:19 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2020-12-18 16:13:39 +0100 |
commit | d613c1771a1986d3c0f1e034155fde41f32f9b8e (patch) | |
tree | b49c070901ed97377088bc2eaebb50a94fc104ad | |
parent | e5bbb4662fd3198c036d2b7732694159d4c79346 (diff) | |
download | guix-d613c1771a1986d3c0f1e034155fde41f32f9b8e.tar.gz guix-d613c1771a1986d3c0f1e034155fde41f32f9b8e.zip |
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'.
-rw-r--r-- | guix/progress.scm | 68 | ||||
-rw-r--r-- | guix/status.scm | 4 |
2 files changed, 43 insertions, 29 deletions
diff --git a/guix/progress.scm b/guix/progress.scm index cd80ae620a..334bd40547 100644 --- a/guix/progress.scm +++ b/guix/progress.scm @@ -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. diff --git a/guix/status.scm b/guix/status.scm index f40d5d59b9..9ca6d92470 100644 --- a/guix/status.scm +++ b/guix/status.scm @@ -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)))))) |