From d613c1771a1986d3c0f1e034155fde41f32f9b8e Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 17 Dec 2020 17:26:19 +0100
Subject: 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'.
---
 guix/progress.scm | 68 +++++++++++++++++++++++++++++++------------------------
 guix/status.scm   |  4 ++++
 2 files changed, 43 insertions(+), 29 deletions(-)

(limited to 'guix')

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 @@ (define (erase-current-line port)
 
 (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 @@ (define failure
         (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 @@ (define erase-current-line*
                          (nar-uri-abbreviation uri)
                          (basename uri))))
             (display-download-progress uri size
+                                       #:tty? tty?
                                        #:start-time
                                        (download-start download)
                                        #:transferred transferred))))))
-- 
cgit v1.2.3