Merge pull request #1415 from tonyg/fix_1414_fd_leak_HEAD

Explicitly close the http-conn on http-sendrecv with method HEAD.
This commit is contained in:
Jay McCarthy 2016-08-15 09:18:18 -04:00 committed by GitHub
commit 986ea517d1

View File

@ -237,6 +237,11 @@
(http-conn-open! hc host-bs #:ssl? ssl? #:port port) (http-conn-open! hc host-bs #:ssl? ssl? #:port port)
hc) hc)
(define (head? method-bss)
(or (equal? method-bss #"HEAD")
(equal? method-bss "HEAD")
(equal? method-bss 'HEAD)))
(define (http-conn-recv! hc (define (http-conn-recv! hc
#:method [method-bss #"GET"] #:method [method-bss #"GET"]
#:content-decode [decodes '(gzip)] #:content-decode [decodes '(gzip)]
@ -248,13 +253,9 @@
(regexp-member #rx#"^(?i:Connection: +close)$" headers))) (regexp-member #rx#"^(?i:Connection: +close)$" headers)))
(when close? (when close?
(http-conn-abandon! hc)) (http-conn-abandon! hc))
(define head?
(or (equal? method-bss #"HEAD")
(equal? method-bss "HEAD")
(equal? method-bss 'HEAD)))
(define-values (raw-response-port wait-for-close?) (define-values (raw-response-port wait-for-close?)
(cond (cond
[head? (values (open-input-bytes #"") #f)] [(head? method-bss) (values (open-input-bytes #"") #f)]
[(regexp-member #rx#"^(?i:Transfer-Encoding: +chunked)$" headers) [(regexp-member #rx#"^(?i:Transfer-Encoding: +chunked)$" headers)
(values (http-conn-response-port/chunked! hc #:close? #t) (values (http-conn-response-port/chunked! hc #:close? #t)
#t)] #t)]
@ -273,7 +274,7 @@
(values (http-conn-response-port/rest! hc) #t)])) (values (http-conn-response-port/rest! hc) #t)]))
(define decoded-response-port (define decoded-response-port
(cond (cond
[head? raw-response-port] [(head? method-bss) raw-response-port]
[(and (memq 'gzip decodes) [(and (memq 'gzip decodes)
(regexp-member #rx#"^(?i:Content-Encoding: +gzip)$" headers) (regexp-member #rx#"^(?i:Content-Encoding: +gzip)$" headers)
(not (eof-object? (peek-byte raw-response-port)))) (not (eof-object? (peek-byte raw-response-port))))
@ -323,13 +324,15 @@
#:data [data #f] #:data [data #f]
#:content-decode [decodes '(gzip)]) #:content-decode [decodes '(gzip)])
(define hc (http-conn-open host-bs #:ssl? ssl? #:port port)) (define hc (http-conn-open host-bs #:ssl? ssl? #:port port))
(http-conn-sendrecv! hc url-bs (begin0 (http-conn-sendrecv! hc url-bs
#:version version-bs #:version version-bs
#:method method-bss #:method method-bss
#:headers headers-bs #:headers headers-bs
#:data data #:data data
#:content-decode decodes #:content-decode decodes
#:close? #t)) #:close? #t)
(when (head? method-bss)
(http-conn-close! hc))))
(define data-procedure/c (define data-procedure/c
(-> (-> (or/c bytes? string?) void?) any)) (-> (-> (or/c bytes? string?) void?) any))