me
/
guix
Archived
1
0
Fork 0

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.
master
Ludovic Courtès 2019-11-28 11:41:32 +01:00
parent 295c6a7e83
commit 9e3f9ac3c0
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 18 additions and 8 deletions

View File

@ -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."