summaryrefslogtreecommitdiff
path: root/guix/scripts/substitute.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/scripts/substitute.scm')
-rwxr-xr-xguix/scripts/substitute.scm26
1 files changed, 18 insertions, 8 deletions
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index ba2fb291d8..421561a4ea 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -526,6 +526,9 @@ initial connection on which HTTP requests are sent."
(let connect ((port port)
(requests requests)
(result seed))
+ (define batch
+ (at-most 1000 requests))
+
;; (format (current-error-port) "connecting (~a requests left)..."
;; (length requests))
(let ((p (or port (guix:open-connection-for-uri
@@ -536,7 +539,7 @@ initial connection on which HTTP requests are sent."
(when (file-port? p)
(setvbuf p 'block (expt 2 16)))
- ;; Send REQUESTS, up to a certain number, in a row.
+ ;; Send BATCH in a row.
;; XXX: Do our own caching to work around inefficiencies when
;; communicating over TLS: <http://bugs.gnu.org/22966>.
(let-values (((buffer get) (open-bytevector-output-port)))
@@ -544,16 +547,21 @@ initial connection on which HTTP requests are sent."
(set-http-proxy-port?! buffer (http-proxy-port? p))
(for-each (cut write-request <> buffer)
- (at-most 1000 requests))
+ batch)
(put-bytevector p (get))
(force-output p))
;; Now start processing responses.
- (let loop ((requests requests)
- (result result))
- (match requests
+ (let loop ((sent batch)
+ (processed 0)
+ (result result))
+ (match sent
(()
- (reverse result))
+ (match (drop requests processed)
+ (()
+ (reverse result))
+ (remainder
+ (connect port remainder result))))
((head tail ...)
(let* ((resp (read-response p))
(body (response-body-port resp))
@@ -564,9 +572,11 @@ initial connection on which HTTP requests are sent."
(match (assq 'connection (response-headers resp))
(('connection 'close)
(close-connection p)
- (connect #f tail result)) ;try again
+ (connect #f ;try again
+ (append tail (drop requests processed))
+ result))
(_
- (loop tail result)))))))))) ;keep going
+ (loop tail (+ 1 processed) result)))))))))) ;keep going
(define (read-to-eof port)
"Read from PORT until EOF is reached. The data are discarded."