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.
This commit is contained in:
parent
295c6a7e83
commit
9e3f9ac3c0
@ -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."
|
||||
|
Loading…
Reference in New Issue
Block a user