diff options
author | Christopher Baines <mail@cbaines.net> | 2021-01-07 19:40:07 +0000 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2021-02-22 20:43:09 +0000 |
commit | e2e853ddb0d964e7b0300334ab51ab89950c2376 (patch) | |
tree | faa262e22a242086b24a6a66c03996cbcef18124 /guix/scripts | |
parent | 87734503a4a1761a4432b601352e5b02340a97f0 (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-x | guix/scripts/substitute.scm | 70 |
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"))) |