From d213cc8c7f085428e3c64243b0d163423e4bb5f6 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 25 Oct 2017 20:57:06 -0700 Subject: substitute: Don't send more than 1000 requests in a row. Fixes . Reported by Jan Nieuwenhuizen . * guix/scripts/substitute.scm (at-most): New procedure. (http-multiple-get): Use it to send at most 1000 requests at once. --- guix/scripts/substitute.scm | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 1fbeed71e8..2fd2bf8104 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -533,6 +533,20 @@ (define (narinfo-request cache-url path) (headers '((User-Agent . "GNU Guile")))) (build-request (string->uri url) #:method 'GET #:headers headers))) +(define (at-most max-length lst) + "If LST is shorter than MAX-LENGTH, return it; otherwise return its +MAX-LENGTH first elements." + (let loop ((len 0) + (lst lst) + (result '())) + (match lst + (() + (reverse result)) + ((head . tail) + (if (>= len max-length) + (reverse result) + (loop (+ 1 len) tail (cons head result))))))) + (define* (http-multiple-get base-uri proc seed requests #:key port (verify-certificate? #t)) "Send all of REQUESTS to the server at BASE-URI. Call PROC for each @@ -553,7 +567,7 @@ (define* (http-multiple-get base-uri proc seed requests (when (file-port? p) (setvbuf p _IOFBF (expt 2 16))) - ;; Send all of REQUESTS in a row. + ;; Send REQUESTS, up to a certain number, in a row. ;; XXX: Do our own caching to work around inefficiencies when ;; communicating over TLS: . (let-values (((buffer get) (open-bytevector-output-port))) @@ -562,7 +576,8 @@ (define* (http-multiple-get base-uri proc seed requests 'http-proxy-port?) (set-http-proxy-port?! buffer (http-proxy-port? p))) - (for-each (cut write-request <> buffer) requests) + (for-each (cut write-request <> buffer) + (at-most 1000 requests)) (put-bytevector p (get)) (force-output p)) -- cgit v1.2.3