[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/11: substitute: Don't send more than 1000 requests in a row.
From: |
Ludovic Courtès |
Subject: |
02/11: substitute: Don't send more than 1000 requests in a row. |
Date: |
Thu, 26 Oct 2017 01:30:07 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit d213cc8c7f085428e3c64243b0d163423e4bb5f6
Author: Ludovic Courtès <address@hidden>
Date: Wed Oct 25 20:57:06 2017 -0700
substitute: Don't send more than 1000 requests in a row.
Fixes <https://bugs.gnu.org/28731>.
Reported by Jan Nieuwenhuizen <address@hidden>.
* 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(-)
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 1fbeed7..2fd2bf8 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -533,6 +533,20 @@ indicates that PATH is unavailable at CACHE-URL."
(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 @@ initial connection on which HTTP requests are sent."
(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 @@ initial connection on which HTTP requests are sent."
'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))
- branch master updated (1765056 -> b1e9837), Ludovic Courtès, 2017/10/26
- 01/11: guix package: '--list-available' does not show superseded packages., Ludovic Courtès, 2017/10/26
- 03/11: challenge: Display an overall summary., Ludovic Courtès, 2017/10/26
- 02/11: substitute: Don't send more than 1000 requests in a row.,
Ludovic Courtès <=
- 05/11: gnu: Add python-capturer., Ludovic Courtès, 2017/10/26
- 07/11: gnu: Add python-coloredlogs., Ludovic Courtès, 2017/10/26
- 09/11: gnu: Add python2-roca-detect., Ludovic Courtès, 2017/10/26
- 08/11: gnu: Add python2-pgpdump., Ludovic Courtès, 2017/10/26
- 11/11: gnu: virt-manager: Enable persistent configuration support., Ludovic Courtès, 2017/10/26
- 04/11: gnu: Add python-humanfriendly., Ludovic Courtès, 2017/10/26
- 10/11: gnu: virt-manager: Wrap with GSettings schema and GIO modules search paths., Ludovic Courtès, 2017/10/26
- 06/11: gnu: Add python-verboselogs., Ludovic Courtès, 2017/10/26