summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
Diffstat (limited to 'guix')
-rw-r--r--guix/build/download.scm61
-rwxr-xr-xguix/scripts/substitute.scm17
2 files changed, 53 insertions, 25 deletions
diff --git a/guix/build/download.scm b/guix/build/download.scm
index 31d60fbcda..9b72e8f795 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -36,8 +36,10 @@
resolve-uri-reference
maybe-expand-mirrors
url-fetch
+ byte-count->string
progress-proc
- uri-abbreviation))
+ uri-abbreviation
+ store-path-abbreviation))
;;; Commentary:
;;;
@@ -96,10 +98,33 @@ width of the bar is BAR-WIDTH."
(make-string filled #\#)
(make-string empty #\space))))
-(define* (progress-proc file size #:optional (log-port (current-output-port)))
+(define (string-pad-middle left right len)
+ "Combine LEFT and RIGHT with enough padding in the middle so that the
+resulting string has length at least LEN. This right justifies RIGHT."
+ (string-append left
+ (string-pad right (max 0 (- len (string-length left))))))
+
+(define (store-url-abbreviation url)
+ "Return a friendlier version of URL for display."
+ (let ((store-path (string-append (%store-directory) "/" (basename url))))
+ ;; Take advantage of the implementation for store paths.
+ (store-path-abbreviation store-path)))
+
+(define* (store-path-abbreviation store-path #:optional (prefix-length 6))
+ "Return an abbreviation of STORE-PATH for display, showing PREFIX-LENGTH
+characters of the hash."
+ (let ((base (basename store-path)))
+ (string-append (string-take base prefix-length)
+ "…"
+ (string-drop base 32))))
+
+(define* (progress-proc file size
+ #:optional (log-port (current-output-port))
+ #:key (abbreviation identity))
"Return a procedure to show the progress of FILE's download, which is SIZE
bytes long. The returned procedure is suitable for use as an argument to
-`dump-port'. The progress report is written to LOG-PORT."
+`dump-port'. The progress report is written to LOG-PORT, with ABBREVIATION
+used to shorten FILE for display."
;; XXX: Because of <http://bugs.gnu.org/19939> this procedure is often not
;; called as frequently as we'd like too; this is especially bad with Nginx
;; on hydra.gnu.org, which returns whole nars as a single chunk.
@@ -123,31 +148,31 @@ bytes long. The returned procedure is suitable for use as an argument to
(/ transferred elapsed)
0))
(left (format #f " ~a ~a"
- (basename file)
+ (abbreviation file)
(byte-count->string size)))
(right (format #f "~a/s ~a ~a~6,1f%"
(byte-count->string throughput)
(seconds->string elapsed)
- (progress-bar %) %))
- ;; TODO: Make this adapt to the actual terminal width.
- (cols 80)
- (num-spaces (max 1 (- cols (+ (string-length left)
- (string-length right)))))
- (gap (make-string num-spaces #\space)))
- (format log-port "~a~a~a" left gap right)
+ (progress-bar %) %)))
+ ;; TODO: Make this adapt to the actual terminal width.
+ (display (string-pad-middle left right 80) log-port)
(display #\cr log-port)
(flush-output-port log-port)
(cont))))
(lambda (transferred cont)
(with-elapsed-time elapsed
- (let ((throughput (if elapsed
- (/ transferred elapsed)
- 0)))
+ (let* ((throughput (if elapsed
+ (/ transferred elapsed)
+ 0))
+ (left (format #f " ~a"
+ (abbreviation file)))
+ (right (format #f "~a/s ~a | ~a transferred"
+ (byte-count->string throughput)
+ (seconds->string elapsed)
+ (byte-count->string transferred))))
+ ;; TODO: Make this adapt to the actual terminal width.
+ (display (string-pad-middle left right 80) log-port)
(display #\cr log-port)
- (format log-port "~a\t~a transferred (~a/s)"
- file
- (byte-count->string transferred)
- (byte-count->string throughput))
(flush-output-port log-port)
(cont))))))))
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index e908bc997e..ec8e6244af 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -31,7 +31,8 @@
#:use-module (guix pki)
#:use-module ((guix build utils) #:select (mkdir-p dump-port))
#:use-module ((guix build download)
- #:select (progress-proc uri-abbreviation))
+ #:select (progress-proc uri-abbreviation
+ store-path-abbreviation byte-count->string))
#:use-module (ice-9 rdelim)
#:use-module (ice-9 regex)
#:use-module (ice-9 match)
@@ -337,8 +338,9 @@ or is signed by an unauthorized key."
(unless %allow-unauthenticated-substitutes?
(assert-valid-signature narinfo signature hash acl)
(when verbose?
+ ;; Visually separate substitutions with a newline.
(format (current-error-port)
- "found valid signature for '~a', from '~a'~%"
+ "~%Found valid signature for ~a~%From ~a~%"
(narinfo-path narinfo)
(uri->string (narinfo-uri narinfo)))))
narinfo))))
@@ -753,13 +755,12 @@ DESTINATION as a nar file. Verify the substitute against ACL."
;; Tell the daemon what the expected hash of the Nar itself is.
(format #t "~a~%" (narinfo-hash narinfo))
- (format (current-error-port) "downloading `~a'~:[~*~; (~,1f MiB installed)~]...~%"
- store-item
-
+ (format (current-error-port) "Downloading ~a~:[~*~; (~a installed)~]...~%"
+ (store-path-abbreviation store-item)
;; Use the Nar size as an estimate of the installed size.
(narinfo-size narinfo)
(and=> (narinfo-size narinfo)
- (cute / <> (expt 2. 20))))
+ (cute byte-count->string <>)))
(let*-values (((raw download-size)
;; Note that Hydra currently generates Nars on the fly
;; and doesn't specify a Content-Length, so
@@ -772,7 +773,9 @@ DESTINATION as a nar file. Verify the substitute against ACL."
(narinfo-size narinfo))))
(progress (progress-proc (uri-abbreviation uri)
dl-size
- (current-error-port))))
+ (current-error-port)
+ #:abbreviation
+ store-path-abbreviation)))
(progress-report-port progress raw)))
((input pids)
(decompressed-port (and=> (narinfo-compression narinfo)