summaryrefslogtreecommitdiff
path: root/guix/scripts
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2021-01-07 19:40:07 +0000
committerChristopher Baines <mail@cbaines.net>2021-02-22 20:43:09 +0000
commite2e853ddb0d964e7b0300334ab51ab89950c2376 (patch)
treefaa262e22a242086b24a6a66c03996cbcef18124 /guix/scripts
parent87734503a4a1761a4432b601352e5b02340a97f0 (diff)
guix: Move http-multiple-get to (guix http-client).
From (guix scripts substitute). This will make it easier to reuse this code. * guix/scripts/substitute.scm (http-multiple-get): Remove, and move to… * guix/http-client.scm (http-multiple-get): …here.
Diffstat (limited to 'guix/scripts')
-rwxr-xr-xguix/scripts/substitute.scm70
1 files changed, 0 insertions, 70 deletions
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index f01892776e..fc6bb54301 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -299,76 +299,6 @@ return its MAX-LENGTH first elements and its tail."
(values (reverse result) lst)
(loop (+ 1 len) tail (cons head result)))))))
-(define* (http-multiple-get base-uri proc seed requests
- #:key port (verify-certificate? #t)
- (open-connection guix:open-connection-for-uri)
- (keep-alive? #t)
- (batch-size 1000))
- "Send all of REQUESTS to the server at BASE-URI. Call PROC for each
-response, passing it the request object, the response, a port from which to
-read the response body, and the previous result, starting with SEED, à la
-'fold'. Return the final result.
-
-When PORT is specified, use it as the initial connection on which HTTP
-requests are sent; otherwise call OPEN-CONNECTION to open a new connection for
-a URI. When KEEP-ALIVE? is false, close the connection port before
-returning."
- (let connect ((port port)
- (requests requests)
- (result seed))
- (define batch
- (at-most batch-size requests))
-
- ;; (format (current-error-port) "connecting (~a requests left)..."
- ;; (length requests))
- (let ((p (or port (open-connection base-uri
- #:verify-certificate?
- verify-certificate?))))
- ;; For HTTPS, P is not a file port and does not support 'setvbuf'.
- (when (file-port? p)
- (setvbuf p 'block (expt 2 16)))
-
- ;; 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)))
- ;; Inherit the HTTP proxying property from P.
- (set-http-proxy-port?! buffer (http-proxy-port? p))
-
- (for-each (cut write-request <> buffer)
- batch)
- (put-bytevector p (get))
- (force-output p))
-
- ;; Now start processing responses.
- (let loop ((sent batch)
- (processed 0)
- (result result))
- (match sent
- (()
- (match (drop requests processed)
- (()
- (unless keep-alive?
- (close-port p))
- (reverse result))
- (remainder
- (connect p remainder result))))
- ((head tail ...)
- (let* ((resp (read-response p))
- (body (response-body-port resp))
- (result (proc head resp body result)))
- ;; The server can choose to stop responding at any time, in which
- ;; case we have to try again. Check whether that is the case.
- ;; Note that even upon "Connection: close", we can read from BODY.
- (match (assq 'connection (response-headers resp))
- (('connection 'close)
- (close-port p)
- (connect #f ;try again
- (drop requests (+ 1 processed))
- result))
- (_
- (loop tail (+ 1 processed) result)))))))))) ;keep going
-
(define (read-to-eof port)
"Read from PORT until EOF is reached. The data are discarded."
(dump-port port (%make-void-port "w")))