From 95936bf25394d2985f9331cb8fa08d5b30cb64a5 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 (flexible-space, truncated-url): New procedures. (progress-proc): Generate a better indeterminate progress string. (nearest-exact-integer, seconds->string, byte-count->string): Move to... * guix/utils.scm: ...here. * 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 | 71 ++++++++++++++++++--------------------------- guix/scripts/substitute.scm | 11 +++---- guix/store.scm | 11 ++++++- guix/utils.scm | 41 +++++++++++++++++++++++++- 4 files changed, 85 insertions(+), 49 deletions(-) diff --git a/guix/build/download.scm b/guix/build/download.scm index 31d60fb..e205f31 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -24,6 +24,8 @@ #:use-module (web response) #:use-module (guix ftp-client) #:use-module (guix build utils) + #:use-module (guix store) + #:use-module (guix utils) #:use-module (rnrs io ports) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) @@ -49,43 +51,12 @@ ;; Size of the HTTP receive buffer. 65536) -(define (nearest-exact-integer x) - "Given a real number X, return the nearest exact integer, with ties going to -the nearest exact even integer." - (inexact->exact (round x))) - (define (duration->seconds duration) "Return the number of seconds represented by DURATION, a 'time-duration' object, as an inexact number." (+ (time-second duration) (/ (time-nanosecond duration) 1e9))) -(define (seconds->string duration) - "Given DURATION in seconds, return a string representing it in 'hh:mm:ss' -format." - (if (not (number? duration)) - "00:00:00" - (let* ((total-seconds (nearest-exact-integer duration)) - (extra-seconds (modulo total-seconds 3600)) - (hours (quotient total-seconds 3600)) - (mins (quotient extra-seconds 60)) - (secs (modulo extra-seconds 60))) - (format #f "~2,'0d:~2,'0d:~2,'0d" hours mins secs)))) - -(define (byte-count->string size) - "Given SIZE in bytes, return a string representing it in a human-readable -way." - (let ((KiB 1024.) - (MiB (expt 1024. 2)) - (GiB (expt 1024. 3)) - (TiB (expt 1024. 4))) - (cond - ((< size KiB) (format #f "~dB" (nearest-exact-integer size))) - ((< size MiB) (format #f "~dKiB" (nearest-exact-integer (/ size KiB)))) - ((< size GiB) (format #f "~,1fMiB" (/ size MiB))) - ((< size TiB) (format #f "~,2fGiB" (/ size GiB))) - (else (format #f "~,3fTiB" (/ size TiB)))))) - (define* (progress-bar % #:optional (bar-width 20)) "Return % as a string representing an ASCII-art progress bar. The total width of the bar is BAR-WIDTH." @@ -96,6 +67,20 @@ width of the bar is BAR-WIDTH." (make-string filled #\#) (make-string empty #\space)))) +(define* (flexible-space left right #:optional (columns 80)) + "Return a string of spaces which can be used to separate LEFT and RIGHT so +that RIGHT is justified to a width of COLUMNS." + (let* ((total-used (+ (string-length left) + (string-length right))) + (num-spaces (max 1 (- columns total-used)))) + (make-string num-spaces #\space))) + +(define (truncated-url 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 @@ -130,24 +115,26 @@ bytes long. The returned procedure is suitable for use as an argument to (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))) + (gap (flexible-space left right))) (format log-port "~a~a~a" left gap right) (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" + (truncated-url 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. + (gap (flexible-space left right))) + (format log-port "~a~a~a" left gap right) (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..2b36793 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -29,6 +29,7 @@ #: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)) @@ -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))) diff --git a/guix/utils.scm b/guix/utils.scm index 44913c6..4d8ab17 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -88,7 +88,10 @@ decompressed-port call-with-decompressed-port compressed-output-port - call-with-compressed-output-port)) + call-with-compressed-output-port + + seconds->string + byte-count->string)) ;;; @@ -767,3 +770,39 @@ etc." ;; In accordance with the GCS, start line and column numbers at 1. Note ;; that unlike LINE and `port-column', COL is actually 1-indexed here... (location file (and line (+ line 1)) col))) + + +;;; +;;; Human readable formatting. +;;; + +(define (nearest-exact-integer x) + "Given a real number X, return the nearest exact integer, with ties going to +the nearest exact even integer." + (inexact->exact (round x))) + +(define (seconds->string duration) + "Given DURATION in seconds, return a string representing it in 'hh:mm:ss' +format." + (if (not (number? duration)) + "00:00:00" + (let* ((total-seconds (nearest-exact-integer duration)) + (extra-seconds (modulo total-seconds 3600)) + (hours (quotient total-seconds 3600)) + (mins (quotient extra-seconds 60)) + (secs (modulo extra-seconds 60))) + (format #f "~2,'0d:~2,'0d:~2,'0d" hours mins secs)))) + +(define (byte-count->string size) + "Given SIZE in bytes, return a string representing it in a human-readable +way." + (let ((KiB 1024.) + (MiB (expt 1024. 2)) + (GiB (expt 1024. 3)) + (TiB (expt 1024. 4))) + (cond + ((< size KiB) (format #f "~dB" (nearest-exact-integer size))) + ((< size MiB) (format #f "~dKiB" (nearest-exact-integer (/ size KiB)))) + ((< size GiB) (format #f "~,1fMiB" (/ size MiB))) + ((< size TiB) (format #f "~,2fGiB" (/ size GiB))) + (else (format #f "~,3fTiB" (/ size TiB)))))) -- 2.5.0