nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

substitute: Improve readability of download progress report. 

* guix/build/download.scm
  (string-pad-middle, store-url-abbreviation, store-path-abbreviation):
  New procedures.
  (progress-proc): Add #:abbreviation parameter and use it.  Generate a
  better indeterminate progress string.
* guix/scripts/substitute.scm (assert-valid-narinfo): Add newlines to output.
  (process-substitution): Use byte-count->string and store-path-abbreviation.

Co-authored-by: Ludovic Courtès <ludo@gnu.org>
master
Steve Sprang 2015-09-14 22:31:11 -07:00 committed by Ludovic Courtès
parent 41ddebdd2a
commit a8be7b9a7a
2 changed files with 53 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
guix/build/download.scm
View File

@ -36,8 +36,10 @@
resolve-uri-reference resolve-uri-reference
maybe-expand-mirrors maybe-expand-mirrors
url-fetch url-fetch
byte-count->string
progress-proc progress-proc
uri-abbreviation)) uri-abbreviation
store-path-abbreviation))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -96,10 +98,33 @@ width of the bar is BAR-WIDTH."
(make-string filled #\#) (make-string filled #\#)
(make-string empty #\space)))) (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 "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 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 ;; 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 ;; 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. ;; 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) (/ transferred elapsed)
0)) 0))
(left (format #f " ~a ~a" (left (format #f " ~a ~a"
(basename file) (abbreviation file)
(byte-count->string size))) (byte-count->string size)))
(right (format #f "~a/s ~a ~a~6,1f%" (right (format #f "~a/s ~a ~a~6,1f%"
(byte-count->string throughput) (byte-count->string throughput)
(seconds->string elapsed) (seconds->string elapsed)
(progress-bar %) %)) (progress-bar %) %)))
;; TODO: Make this adapt to the actual terminal width. ;; TODO: Make this adapt to the actual terminal width.
(cols 80) (display (string-pad-middle left right 80) log-port)
(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)
(display #\cr log-port) (display #\cr log-port)
(flush-output-port log-port) (flush-output-port log-port)
(cont)))) (cont))))
(lambda (transferred cont) (lambda (transferred cont)
(with-elapsed-time elapsed (with-elapsed-time elapsed
(let ((throughput (if elapsed (let* ((throughput (if elapsed
(/ transferred elapsed) (/ transferred elapsed)
0))) 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) (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) (flush-output-port log-port)
(cont)))))))) (cont))))))))

17
guix/scripts/substitute.scm
View File

@ -31,7 +31,8 @@
#:use-module (guix pki) #:use-module (guix pki)
#:use-module ((guix build utils) #:select (mkdir-p dump-port)) #:use-module ((guix build utils) #:select (mkdir-p dump-port))
#:use-module ((guix build download) #: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 rdelim)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 match) #:use-module (ice-9 match)
@ -337,8 +338,9 @@ or is signed by an unauthorized key."
(unless %allow-unauthenticated-substitutes? (unless %allow-unauthenticated-substitutes?
(assert-valid-signature narinfo signature hash acl) (assert-valid-signature narinfo signature hash acl)
(when verbose? (when verbose?
;; Visually separate substitutions with a newline.
(format (current-error-port) (format (current-error-port)
"found valid signature for '~a', from '~a'~%" "~%Found valid signature for ~a~%From ~a~%"
(narinfo-path narinfo) (narinfo-path narinfo)
(uri->string (narinfo-uri narinfo))))) (uri->string (narinfo-uri narinfo)))))
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. ;; Tell the daemon what the expected hash of the Nar itself is.
(format #t "~a~%" (narinfo-hash narinfo)) (format #t "~a~%" (narinfo-hash narinfo))
(format (current-error-port) "downloading `~a'~:[~*~; (~,1f MiB installed)~]...~%" (format (current-error-port) "Downloading ~a~:[~*~; (~a installed)~]...~%"
store-item (store-path-abbreviation store-item)
;; Use the Nar size as an estimate of the installed size. ;; Use the Nar size as an estimate of the installed size.
(narinfo-size narinfo) (narinfo-size narinfo)
(and=> (narinfo-size narinfo) (and=> (narinfo-size narinfo)
(cute / <> (expt 2. 20)))) (cute byte-count->string <>)))
(let*-values (((raw download-size) (let*-values (((raw download-size)
;; Note that Hydra currently generates Nars on the fly ;; Note that Hydra currently generates Nars on the fly
;; and doesn't specify a Content-Length, so ;; 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)))) (narinfo-size narinfo))))
(progress (progress-proc (uri-abbreviation uri) (progress (progress-proc (uri-abbreviation uri)
dl-size dl-size
(current-error-port)))) (current-error-port)
#:abbreviation
store-path-abbreviation)))
(progress-report-port progress raw))) (progress-report-port progress raw)))
((input pids) ((input pids)
(decompressed-port (and=> (narinfo-compression narinfo) (decompressed-port (and=> (narinfo-compression narinfo)