From 9e3f9ac3c00906f5bc647ea8398e4ed5a370614e Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 28 Nov 2019 11:41:32 +0100
Subject: 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.
---
 guix/scripts/substitute.scm | 26 ++++++++++++++++++--------
 1 file changed, 18 insertions(+), 8 deletions(-)

(limited to 'guix')

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 @@ (define* (http-multiple-get base-uri proc seed requests
   (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 @@ (define* (http-multiple-get base-uri proc seed requests
       (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 @@ (define* (http-multiple-get base-uri proc seed requests
         (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 @@ (define* (http-multiple-get base-uri proc seed requests
              (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."
-- 
cgit v1.2.3