Work around racket/racket#1414.
This commit is contained in:
parent
2afc337396
commit
43b70a6a91
|
@ -111,6 +111,13 @@
|
||||||
|
|
||||||
;; Already present in net/url, but that variant doesn't take #:version
|
;; Already present in net/url, but that variant doesn't take #:version
|
||||||
;; or allow overriding of #:ssl? and #:port.
|
;; or allow overriding of #:ssl? and #:port.
|
||||||
|
;;
|
||||||
|
;; Furthermore, currently 2016-08-14 there is a fd leak when using
|
||||||
|
;; method HEAD with `http-sendrecv` [1], so we implement our own crude
|
||||||
|
;; connection management here.
|
||||||
|
;;
|
||||||
|
;; [1] https://github.com/racket/racket/issues/1414
|
||||||
|
;;
|
||||||
(define (http-sendrecv/url u
|
(define (http-sendrecv/url u
|
||||||
#:ssl? [ssl? (equal? (url-scheme u) "https")]
|
#:ssl? [ssl? (equal? (url-scheme u) "https")]
|
||||||
#:port [port (or (url-port u) (if ssl? 443 80))]
|
#:port [port (or (url-port u) (if ssl? 443 80))]
|
||||||
|
@ -119,15 +126,17 @@
|
||||||
#:headers [headers '()]
|
#:headers [headers '()]
|
||||||
#:data [data #f]
|
#:data [data #f]
|
||||||
#:content-decode [decodes '(gzip)])
|
#:content-decode [decodes '(gzip)])
|
||||||
(http-sendrecv (url-host u)
|
(define hc (http-conn-open (url-host u) #:ssl? ssl? #:port port))
|
||||||
(url->string u)
|
(http-conn-send! hc (url->string u)
|
||||||
#:ssl? ssl?
|
|
||||||
#:port port
|
|
||||||
#:version version
|
#:version version
|
||||||
#:method method
|
#:method method
|
||||||
#:headers headers
|
#:headers headers
|
||||||
#:data data
|
#:data data
|
||||||
#:content-decode decodes))
|
#:content-decode decodes
|
||||||
|
#:close? #t)
|
||||||
|
(begin0 (http-conn-recv! hc #:method method #:content-decode decodes #:close? #t)
|
||||||
|
(when (member method (list #"HEAD" "HEAD" 'HEAD))
|
||||||
|
(http-conn-close! hc))))
|
||||||
|
|
||||||
(define-syntax-rule (http/interpret-response customization ... req-expr)
|
(define-syntax-rule (http/interpret-response customization ... req-expr)
|
||||||
(call-with-values (lambda () req-expr)
|
(call-with-values (lambda () req-expr)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user