adjust the "Transfer-Encoding: chunked" code to re-use bytes more
agressively
This commit is contained in:
parent
80ca2b34ff
commit
1fa6129afc
|
@ -185,26 +185,33 @@
|
||||||
(getpost-impure-port #f url post-data strings))
|
(getpost-impure-port #f url post-data strings))
|
||||||
|
|
||||||
;; getpost-pure-port : bool x url x list (str) -> in-port
|
;; getpost-pure-port : bool x url x list (str) -> in-port
|
||||||
(define (getpost-pure-port get? url post-data strings)
|
(define (getpost-pure-port get? url post-data strings redirections)
|
||||||
(let ([scheme (url-scheme url)])
|
(let ([scheme (url-scheme url)])
|
||||||
(cond [(not scheme)
|
(cond [(not scheme)
|
||||||
(schemeless-url url)]
|
(schemeless-url url)]
|
||||||
[(or (string=? scheme "http")
|
[(or (string=? scheme "http")
|
||||||
(string=? scheme "https"))
|
(string=? scheme "https"))
|
||||||
|
(let loop ([redirections redirections])
|
||||||
|
(cond
|
||||||
|
[(zero? redirections)
|
||||||
(let ([port (http://getpost-impure-port
|
(let ([port (http://getpost-impure-port
|
||||||
get? url post-data strings)])
|
get? url post-data strings)])
|
||||||
(purify-http-port port))]
|
(purify-http-port port))]
|
||||||
|
[else
|
||||||
|
(let ([port (http://getpost-impure-port
|
||||||
|
get? url post-data strings)])
|
||||||
|
(purify-http-port port))]))]
|
||||||
[(string=? scheme "file")
|
[(string=? scheme "file")
|
||||||
(file://get-pure-port url)]
|
(file://get-pure-port url)]
|
||||||
[else (url-error "Scheme ~a unsupported" scheme)])))
|
[else (url-error "Scheme ~a unsupported" scheme)])))
|
||||||
|
|
||||||
;; get-pure-port : url [x list (str)] -> in-port
|
;; get-pure-port : url [x list (str)] -> in-port
|
||||||
(define (get-pure-port url [strings '()])
|
(define (get-pure-port url [strings '()] #:redirections [redirections 0])
|
||||||
(getpost-pure-port #t url #f strings))
|
(getpost-pure-port #t url #f strings redirections))
|
||||||
|
|
||||||
;; post-pure-port : url bytes [x list (str)] -> in-port
|
;; post-pure-port : url bytes [x list (str)] -> in-port
|
||||||
(define (post-pure-port url post-data [strings '()])
|
(define (post-pure-port url post-data [strings '()])
|
||||||
(getpost-pure-port #f url post-data strings))
|
(getpost-pure-port #f url post-data strings 0))
|
||||||
|
|
||||||
;; display-pure-port : in-port -> ()
|
;; display-pure-port : in-port -> ()
|
||||||
(define (display-pure-port server->client)
|
(define (display-pure-port server->client)
|
||||||
|
@ -349,17 +356,25 @@
|
||||||
(close-output-port op))))
|
(close-output-port op))))
|
||||||
|
|
||||||
(define (http-pipe-chunk ip 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 size-str (read-line ip 'return-linefeed))
|
||||||
(define chunk-size (string->number size-str 16))
|
(define chunk-size (string->number size-str 16))
|
||||||
(unless chunk-size
|
(unless chunk-size
|
||||||
(error 'http-pipe-chunk "Could not parse ~S as hexadecimal number" size-str))
|
(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)
|
(if (zero? chunk-size)
|
||||||
(begin (flush-output op)
|
(begin (flush-output op)
|
||||||
(close-output-port op))
|
(close-output-port op))
|
||||||
(let* ([bs (read-bytes chunk-size ip)]
|
(let* ([bs (if use-last-bytes?
|
||||||
[crlf (read-bytes 2 ip)])
|
(begin
|
||||||
(write-bytes bs op)
|
(read-bytes! last-bytes ip 0 chunk-size)
|
||||||
(http-pipe-chunk ip op))))
|
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)
|
(define character-set-size 256)
|
||||||
|
|
||||||
|
|
|
@ -47,6 +47,11 @@
|
||||||
=>
|
=>
|
||||||
"This is the data in the first chunk and this is the second one"
|
"This is the data in the first chunk and this is the second one"
|
||||||
|
|
||||||
|
(get-pure
|
||||||
|
"HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\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")
|
||||||
|
=>
|
||||||
|
"This is the data in the first chand this is the second oneXXXXXXX"
|
||||||
|
|
||||||
(get-impure
|
(get-impure
|
||||||
"HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n23\r\nThis is the data in the first chunk\r\n1A\r\nand this is the second one\r\n0\r\n")
|
"HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n23\r\nThis is the data in the first chunk\r\n1A\r\nand this is the second one\r\n0\r\n")
|
||||||
=>
|
=>
|
||||||
|
|
Loading…
Reference in New Issue
Block a user