From c8a04ac71e347de49a2795c4ef503a5abac2f882 Mon Sep 17 00:00:00 2001 From: Steve Sprang Date: Mon, 14 Sep 2015 22:31:11 -0700 Subject: [PATCH] substitute: Improve readability of substitute-related output. * guix/build/download.scm (string-pad-middle, store-url-abbreviation): New procedures. (progress-proc): Generate a better indeterminate progress string. * guix/store.scm (truncated-store-path): New procedure. * guix/scripts/substitute.scm (assert-valid-narinfo): Add newlines to output. (process-substitution): Use byte-count->string and truncated-store-path. --- guix/build/download.scm | 42 ++++++++++++++++++++++++++++-------------- guix/scripts/substitute.scm | 13 +++++++------ guix/store.scm | 11 ++++++++++- 3 files changed, 45 insertions(+), 21 deletions(-) diff --git a/guix/build/download.scm b/guix/build/download.scm index 31d60fb..0358136 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -24,6 +24,7 @@ #:use-module (web response) #:use-module (guix ftp-client) #:use-module (guix build utils) + #:use-module (guix store) #:use-module (rnrs io ports) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) @@ -36,6 +37,7 @@ resolve-uri-reference maybe-expand-mirrors url-fetch + byte-count->string progress-proc uri-abbreviation)) @@ -96,6 +98,18 @@ width of the bar is BAR-WIDTH." (make-string filled #\#) (make-string empty #\space)))) +(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-prefix) "/" (basename url)))) + ;; take advantage of the implementation for store paths + (truncated-store-path store-path))) + (define* (progress-proc file size #:optional (log-port (current-output-port))) "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 @@ -128,26 +142,26 @@ bytes long. The returned procedure is suitable for use as an argument to (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" + (store-url-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 e908bc9..9c6e047 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -29,9 +29,10 @@ #:use-module (guix base64) #:use-module (guix pk-crypto) #:use-module (guix pki) + #:use-module (guix store) #: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 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)~]...~%" + (truncated-store-path 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 diff --git a/guix/store.scm b/guix/store.scm index 132b8a3..a1b76e3 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -124,7 +124,8 @@ store-path-package-name store-path-hash-part direct-store-path - log-file)) + log-file + truncated-store-path)) (define %protocol-version #x10c) @@ -1088,3 +1089,11 @@ must be an absolute store file name, or a derivation file name." ;; Return the first that works. (any (cut log-file store <>) derivers)) (_ #f))))) + +(define* (truncated-store-path store-path #:optional (prefix-length 6)) + "Return a friendlier version of STORE-PATH for display." + (let* ((hash-part (store-path-hash-part store-path)) + (package-name (store-path-package-name store-path)) + (safe-length (max 0 (min prefix-length 24))) + (prefix (string-take hash-part safe-length))) + (string-append prefix "…" package-name))) -- 2.5.0