summaryrefslogtreecommitdiff
path: root/guix/substitutes.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/substitutes.scm')
-rw-r--r--guix/substitutes.scm49
1 files changed, 27 insertions, 22 deletions
diff --git a/guix/substitutes.scm b/guix/substitutes.scm
index dc94ccc8e4..08f8c24efd 100644
--- a/guix/substitutes.scm
+++ b/guix/substitutes.scm
@@ -173,18 +173,14 @@ if file doesn't exist, and the narinfo otherwise."
(apply throw args)))))
(define* (fetch-narinfos url paths
- #:key (open-connection guix:open-connection-for-uri))
+ #:key
+ (open-connection guix:open-connection-for-uri)
+ (make-progress-reporter
+ (const progress-reporter/silent)))
"Retrieve all the narinfos for PATHS from the cache at URL and return them."
- (define update-progress!
- (let ((done 0)
- (total (length paths)))
- (lambda ()
- (display "\r\x1b[K" (current-error-port)) ;erase current line
- (force-output (current-error-port))
- (format (current-error-port)
- (G_ "updating substitutes from '~a'... ~5,1f%")
- url (* 100. (/ done total)))
- (set! done (+ 1 done)))))
+ (define progress-reporter
+ (make-progress-reporter (length paths)
+ #:url url))
(define hash-part->path
(let ((mapping (fold (lambda (path result)
@@ -206,7 +202,7 @@ if file doesn't exist, and the narinfo otherwise."
(len (response-content-length response))
(cache (response-cache-control response))
(ttl (and cache (assoc-ref cache 'max-age))))
- (update-progress!)
+ (progress-reporter-report! progress-reporter)
;; Make sure to read no more than LEN bytes since subsequent bytes may
;; belong to the next response.
@@ -238,7 +234,7 @@ if file doesn't exist, and the narinfo otherwise."
;; narinfos, which provides a much stronger guarantee.
(let* ((requests (map (cut narinfo-request url <>) paths))
(result (begin
- (update-progress!)
+ (start-progress-reporter! progress-reporter)
(call-with-connection-error-handling
uri
(lambda ()
@@ -247,7 +243,7 @@ if file doesn't exist, and the narinfo otherwise."
requests
#:open-connection open-connection
#:verify-certificate? #f))))))
- (newline (current-error-port))
+ (stop-progress-reporter! progress-reporter)
result))
((file #f)
(let* ((base (string-append (uri-path uri) "/"))
@@ -297,7 +293,9 @@ for PATH."
(values #f #f))))
(define* (lookup-narinfos cache paths
- #:key (open-connection guix:open-connection-for-uri))
+ #:key (open-connection guix:open-connection-for-uri)
+ (make-progress-reporter
+ (const progress-reporter/silent)))
"Return the narinfos for PATHS, invoking the server at CACHE when no
information is available locally."
(let-values (((cached missing)
@@ -312,15 +310,20 @@ information is available locally."
'()
'()
paths)))
- (if (null? missing)
- cached
- (let ((missing (fetch-narinfos cache missing
- #:open-connection open-connection)))
- (append cached (or missing '()))))))
+ (values (if (null? missing)
+ cached
+ (let ((missing (fetch-narinfos cache missing
+ #:open-connection open-connection
+ #:make-progress-reporter
+ make-progress-reporter)))
+ (append cached (or missing '()))))
+ (length missing))))
(define* (lookup-narinfos/diverse caches paths authorized?
#:key (open-connection
- guix:open-connection-for-uri))
+ guix:open-connection-for-uri)
+ (make-progress-reporter
+ (const progress-reporter/silent)))
"Look up narinfos for PATHS on all of CACHES, a list of URLS, in that order.
That is, when a cache lacks an AUTHORIZED? narinfo, look it up in the next
cache, and so on.
@@ -353,7 +356,9 @@ AUTHORIZED? narinfo."
(match caches
((cache rest ...)
(let* ((narinfos (lookup-narinfos cache paths
- #:open-connection open-connection))
+ #:open-connection open-connection
+ #:make-progress-reporter
+ make-progress-reporter))
(definite (map narinfo-path (filter authorized? narinfos)))
(missing (lset-difference string=? paths definite))) ;XXX: perf
(loop rest missing