fix `{put,head}-[im]pure-port'

Connection wasn't converted to a port, and included a repeated
layer of chunk decoding.
This commit is contained in:
Matthew Flatt 2013-08-24 15:21:06 -06:00
parent 7e0d3beb67
commit 100cc0f84e
2 changed files with 18 additions and 61 deletions

View File

@ -57,6 +57,10 @@
(make-tester get-pure-port/headers))
(define get-pure/headers/redirect
(make-tester (λ (x) (get-pure-port/headers x #:redirections 1))))
(define put-pure
(make-tester (lambda (url) (put-pure-port url #"data"))))
(define put-impure
(make-tester (lambda (url) (put-impure-port url #"data"))))
(test
(get-pure
@ -131,7 +135,17 @@
"HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\nAnother-Header: ta-daa\r\n\r\n20\r\nThis is the data in the first ch\r\n21\r\nand this is the second oneXXXXXXX\r\n0\r\n")
=>
(values "This is the data in the first chand this is the second oneXXXXXXX"
"Content-Type: text/plain\r\nTransfer-Encoding: chunked\r\nAnother-Header: ta-daa\r\n"))))
"Content-Type: text/plain\r\nTransfer-Encoding: chunked\r\nAnother-Header: ta-daa\r\n")))
(test
(put-pure
"HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n24\r\nThis is the data in the first chunk \r\n1A\r\nand this is the second one\r\n0\r\n")
=>
"This is the data in the first chunk and this is the second one"
(put-impure
"HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\n\r\nThis is the data in the first chunk and this is the second one\r\n")
=>
"HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\n\r\nThis is the data in the first chunk and this is the second one\r\n"))
(provide tests)
(module+ main (tests))

View File

@ -419,66 +419,9 @@
(if m (read-string (cdar m) port) "")))
;; purify-http-port : in-port -> in-port
;; returns a new port, closes the old one when done pumping
(define (purify-http-port in-port)
(define-values (in-pipe out-pipe) (make-pipe))
(thread
(λ ()
(define status (http-read-status in-port))
(define chunked? (http-read-headers in-port))
(http-pipe-data chunked? in-port out-pipe)
(close-input-port in-port)))
in-pipe)
(define (http-read-status ip)
(read-line ip 'return-linefeed))
(define (http-read-headers ip)
(define l (read-line ip 'return-linefeed))
(when (eof-object? l)
(error 'purify-http-port "Connection ended before headers ended"))
(if (string=? l "")
#f
(if (string=? l chunked-header-line)
(begin (http-read-headers ip)
#t)
(http-read-headers ip))))
(define chunked-header-line "Transfer-Encoding: chunked")
(define close-header-line "Connection: close")
(define (http-pipe-data chunked? ip op)
(with-handlers ([exn:fail? (lambda (exn)
(log-net/url-error (exn-message exn)))])
(if chunked?
(http-pipe-chunk ip op)
(begin
(copy-port ip op)
(flush-output op)
(close-output-port op)))))
(define (http-pipe-chunk ip op)
(define crlf-bytes (make-bytes 2))
(let loop ([last-bytes #f])
(define size-str (read-line ip 'return-linefeed))
(define chunk-size (string->number size-str 16))
(unless chunk-size
(error 'http-pipe-chunk "Could not parse ~S as hexadecimal number" size-str))
(define use-last-bytes?
(and last-bytes (<= chunk-size (bytes-length last-bytes))))
(if (zero? chunk-size)
(begin (flush-output op)
(close-output-port op))
(let* ([bs (if use-last-bytes?
(begin
(read-bytes! last-bytes ip 0 chunk-size)
last-bytes)
(read-bytes chunk-size ip))]
[crlf (read-bytes! crlf-bytes ip 0 2)])
(write-bytes bs op 0 chunk-size)
(loop bs)))))
(define character-set-size 256)
(purify-port in-port)
in-port)
;; netscape/string->url : str -> url
(define (netscape/string->url string)
@ -718,7 +661,7 @@
#:method method
#:headers strings
#:data data)
hc))
(http-conn-impure-port hc)))
(define current-url-encode-mode (make-parameter 'recommended))