summaryrefslogtreecommitdiff
path: root/guix/scripts/substitute.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-11-28 11:41:32 +0100
committerLudovic Courtès <ludo@gnu.org>2019-11-28 13:30:53 +0100
commit9e3f9ac3c00906f5bc647ea8398e4ed5a370614e (patch)
tree3b3208e6786db885af597c489e64726b03543828 /guix/scripts/substitute.scm
parent295c6a7e834d1bede4cc5c9211b594bfbfa5ff35 (diff)
substitute: 'http-multiple-get' no longer drops requests above 1,000.
Previously, in the unlikely case 'http-multiple-get' was passed more than 1,000 requests, it could have dropped all those above 1,000. * guix/scripts/substitute.scm (http-multiple-get): Define 'batch'. Use that for the 'write-request' loop. Add 'processed' parameter to 'loop' and use that to compute the remaining requests and call 'connect' in the recursion base case.
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."