kreyren/guix-kreyren
1
0
Fork 0
Code Issues 1 Pull Requests 1 Releases Activity

http-client: Correctly handle redirects when #:keep-alive? #t.

Browse Source 
Previously PORT would be closed unconditionally, which broke redirects
when #:keep-alive? #t is given.

* guix/http-client.scm (http-fetch): Make 'port' a parameter of 'loop'.
Upon 3xx responses, do not close PORT is KEEP-ALIVE? is true, but consume
RESP's body.  Add second argument to 'loop'.
This commit is contained in:
Ludovic Courtès 2022-03-03 21:37:27 +01:00
parent 55e8e283ae
commit 8786c2e8d7
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 24 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
guix/http-client.scm
View File

@ -100,14 +100,15 @@ TIMEOUT is #f, connection establishment never times out.
Write information about redirects to LOG-PORT.
Raise an '&http-get-error' condition if downloading fails."
(let loop ((uri (if (string? uri)
(string->uri uri)
uri)))
(let ((port (or port (open-connection uri
#:verify-certificate?
verify-certificate?
#:timeout timeout)))
(headers (match (uri-userinfo uri)
(define uri*
(if (string? uri) (string->uri uri) uri))
(let loop ((uri uri*)
(port (or port (open-connection uri*
#:verify-certificate?
verify-certificate?
#:timeout timeout))))
(let ((headers (match (uri-userinfo uri)
((? string? str)
(cons (cons 'Authorization
(string-append "Basic "
@ -131,11 +132,23 @@ Raise an '&http-get-error' condition if downloading fails."
303 ; see other
307 ; temporary redirection
308) ; permanent redirection
(let ((uri (resolve-uri-reference (response-location resp) uri)))
(close-port port)
(let ((host (uri-host uri))
(uri (resolve-uri-reference (response-location resp) uri)))
(if keep-alive?
(dump-port data (%make-void-port "w0")
(response-content-length resp))
(close-port port))
(format log-port (G_ "following redirection to `~a'...~%")
(uri->string uri))
(loop uri)))
(loop uri
(or (and keep-alive?
(or (not (uri-host uri))
(string=? host (uri-host uri)))
port)
(open-connection uri*
#:verify-certificate?
verify-certificate?
#:timeout timeout)))))
(else
(raise (condition (&http-get-error
(uri uri)