@@ -103,15 +103,17 @@ (define* (http-fetch uri #:key port (text? #f) (buffered? #t)
When ACCEPT-ALL-RESPONSE-CODES? is false then raise an '&http-get-error'
condition if downloading fails, otherwise return the response regardless
of the reponse code."
- (define uri*
+ (define parsed-initial-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)
+ (define (open-connection* uri)
+ (open-connection uri
+ #:verify-certificate? verify-certificate?
+ #:timeout timeout))
+
+ (let loop ((current-uri parsed-initial-uri)
+ (current-port (or port (open-connection parsed-initial-uri))))
+ (let ((headers (match (uri-userinfo current-uri)
((? string? str)
(cons (cons 'Authorization
(string-append "Basic "
@@ -119,10 +121,10 @@ (define uri*
(string->utf8 str))))
headers))
(_ headers))))
- (unless (or buffered? (not (file-port? port)))
- (setvbuf port 'none))
+ (unless (or buffered? (not (file-port? current-port)))
+ (setvbuf current-port 'none))
(let*-values (((resp data)
- (http-get uri #:streaming? #t #:port port
+ (http-get current-uri #:streaming? #t #:port current-port
#:keep-alive? keep-alive?
#:headers headers))
((code)
@@ -135,28 +137,26 @@ (define uri*
303 ; see other
307 ; temporary redirection
308) ; permanent redirection
- (let ((host (uri-host uri))
- (uri (resolve-uri-reference (response-location resp) uri)))
+ (let ((host (uri-host current-uri))
+ (new-uri (resolve-uri-reference (response-location resp)
+ current-uri)))
(if keep-alive?
(dump-port data (%make-void-port "w0")
(response-content-length resp))
- (close-port port))
+ (close-port current-port))
(format log-port (G_ "following redirection to `~a'...~%")
- (uri->string uri))
- (loop uri
+ (uri->string new-uri))
+ (loop new-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)))))
+ (or (not (uri-host new-uri))
+ (string=? host (uri-host new-uri)))
+ current-port)
+ (open-connection* new-uri)))))
(else
(if accept-all-response-codes?
(values data (response-content-length resp))
(raise (condition (&http-get-error
- (uri uri)
+ (uri current-uri)
(code code)
(reason (response-reason-phrase resp))
(headers (response-headers resp)))
@@ -165,7 +165,7 @@ (define uri*
(format
#f
(G_ "~a: HTTP download failed: ~a (~s)")
- (uri->string uri) code
+ (uri->string current-uri) code
(response-reason-phrase resp)))))))))))))
(define-syntax-rule (false-if-networking-error exp)