ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-27 04:59:27 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

substitute: Don't send more than 1000 requests in a row.

Browse source 
Fixes <https://bugs.gnu.org/28731>.
Reported by Jan Nieuwenhuizen <janneke@gnu.org>.

* guix/scripts/substitute.scm (at-most): New procedure.
(http-multiple-get): Use it to send at most 1000 requests at once.
This commit is contained in:
Ludovic Courtès 2017-10-25 20:57:06 -07:00
parent 44c6a87f53
commit d213cc8c7f
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 17 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
guix/scripts/substitute.scm
View file

@ -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: <http://bugs.gnu.org/22966>.
(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))