diff options
Diffstat (limited to 'guix')
| -rw-r--r-- | guix/build/download.scm | 61 | ||||
| -rwxr-xr-x | guix/scripts/substitute.scm | 17 |
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) |