From 1fa6129afcec97fe6d81d823310b62fbd82e29ff Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Sun, 2 Oct 2011 21:06:35 -0500
Subject: [PATCH] adjust the "Transfer-Encoding: chunked" code to re-use bytes
 more agressively

---
 collects/net/url.rkt            | 51 +++++++++++++++++++++------------
 collects/tests/net/url-port.rkt |  5 ++++
 2 files changed, 38 insertions(+), 18 deletions(-)

diff --git a/collects/net/url.rkt b/collects/net/url.rkt
index d2afbc9d8b..72dce076fc 100644
--- a/collects/net/url.rkt
+++ b/collects/net/url.rkt
@@ -185,26 +185,33 @@
   (getpost-impure-port #f url post-data strings))
 
 ;; 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)])
     (cond [(not scheme)
            (schemeless-url url)]
           [(or (string=? scheme "http")
                (string=? scheme "https"))
-           (let ([port (http://getpost-impure-port
-                        get? url post-data strings)])
-             (purify-http-port port))]
+           (let loop ([redirections redirections])
+             (cond
+               [(zero? redirections)
+                (let ([port (http://getpost-impure-port
+                             get? url post-data strings)])
+                  (purify-http-port port))]
+               [else
+                (let ([port (http://getpost-impure-port
+                             get? url post-data strings)])
+                  (purify-http-port port))]))]
           [(string=? scheme "file")
            (file://get-pure-port url)]
           [else (url-error "Scheme ~a unsupported" scheme)])))
 
 ;; get-pure-port : url [x list (str)] -> in-port
-(define (get-pure-port url [strings '()])
-  (getpost-pure-port #t url #f strings))
+(define (get-pure-port url [strings '()] #:redirections [redirections 0])
+  (getpost-pure-port #t url #f strings redirections))
 
 ;; post-pure-port : url bytes [x list (str)] -> in-port
 (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 -> ()
 (define (display-pure-port server->client)
@@ -349,17 +356,25 @@
         (close-output-port op))))
 
 (define (http-pipe-chunk ip op)
-  (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))
-  (if (zero? chunk-size)
-      (begin (flush-output op)
-             (close-output-port op))
-      (let* ([bs (read-bytes chunk-size ip)]
-             [crlf (read-bytes 2 ip)])
-        (write-bytes bs op)
-        (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)
 
diff --git a/collects/tests/net/url-port.rkt b/collects/tests/net/url-port.rkt
index 526542258d..d7e4cdda9e 100644
--- a/collects/tests/net/url-port.rkt
+++ b/collects/tests/net/url-port.rkt
@@ -47,6 +47,11 @@
    =>
    "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
     "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")
    =>