aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-12-17 17:26:19 +0100
committerLudovic Courtès <ludo@gnu.org>2020-12-18 16:13:39 +0100
commitd613c1771a1986d3c0f1e034155fde41f32f9b8e (patch)
treeb49c070901ed97377088bc2eaebb50a94fc104ad
parente5bbb4662fd3198c036d2b7732694159d4c79346 (diff)
downloadguix-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.scm68
-rw-r--r--guix/status.scm4
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))))))