diff options
author | Marius Bakke <mbakke@fastmail.com> | 2019-11-28 16:47:01 +0100 |
---|---|---|
committer | Marius Bakke <mbakke@fastmail.com> | 2019-11-28 16:47:01 +0100 |
commit | 34f849a945d25daa76d93839dcf8768c8b45b636 (patch) | |
tree | 33cde8cf068593f29366ba3702aabdb75b5fa126 /guix/scripts/substitute.scm | |
parent | 0897ad7fac04fc9d814e83eed46e88c7bf9740bc (diff) | |
parent | c09f598d94af81f326fe1d4cf2ab344d4e720679 (diff) | |
download | guix-patches-34f849a945d25daa76d93839dcf8768c8b45b636.tar guix-patches-34f849a945d25daa76d93839dcf8768c8b45b636.tar.gz |
Merge branch 'master' into staging
Diffstat (limited to 'guix/scripts/substitute.scm')
-rwxr-xr-x | guix/scripts/substitute.scm | 26 |
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." |