From 78151e073b696522cb187c5cb480bd9cb9d5599c Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Tue, 13 Sep 2011 08:57:51 -0600
Subject: [PATCH] Fixing the handling of request bodies on non-POST methods

---
 collects/meta/props                      |  1 +
 collects/tests/web-server/pr/methods.rkt | 22 ++++++++++++++++++++++
 collects/web-server/http/request.rkt     | 14 +++++---------
 3 files changed, 28 insertions(+), 9 deletions(-)
 create mode 100644 collects/tests/web-server/pr/methods.rkt

diff --git a/collects/meta/props b/collects/meta/props
index 992b4f6f08..1c2a7a054c 100755
--- a/collects/meta/props
+++ b/collects/meta/props
@@ -1990,6 +1990,7 @@ path/s is either such a string or a list of them.
 "collects/tests/utils/gui.rkt" drdr:command-line (gracket-text "-t" *)
 "collects/tests/web-server" responsible (jay)
 "collects/tests/web-server/pr/length.rkt" drdr:command-line #f
+"collects/tests/web-server/pr/methods.rkt" drdr:command-line #f
 "collects/tests/web-server/run-all-tests.rkt" drdr:timeout 300
 "collects/tests/web-server/servlet-env/env.rkt" drdr:command-line (mzc *)
 "collects/tests/web-server/servlet-env/insta.rkt" drdr:command-line (mzc "-k" *)
diff --git a/collects/tests/web-server/pr/methods.rkt b/collects/tests/web-server/pr/methods.rkt
new file mode 100644
index 0000000000..16f923a48d
--- /dev/null
+++ b/collects/tests/web-server/pr/methods.rkt
@@ -0,0 +1,22 @@
+#lang racket
+
+(require web-server/servlet-env
+         web-server/http/xexpr
+         web-server/http/request-structs
+         web-server/dispatch)
+
+(define-values (app-dispatch app-url)
+    (dispatch-rules
+     [("") index]
+     [else index]))
+
+(define (index req)
+  (response/xexpr `(html (p ,(bytes->string/utf-8 (request-method req)))
+                         (p ,(cond ((bytes? (request-post-data/raw req))
+                                    (bytes->string/utf-8 (request-post-data/raw req)))
+                                   (else "No request body"))))))
+
+(serve/servlet app-dispatch
+               #:port 8000
+               #:servlet-regexp #rx""
+               #:command-line? #t)
\ No newline at end of file
diff --git a/collects/web-server/http/request.rkt b/collects/web-server/http/request.rkt
index 03fbf8cd98..900f6dfbb4 100644
--- a/collects/web-server/http/request.rkt
+++ b/collects/web-server/http/request.rkt
@@ -209,15 +209,14 @@
             [(struct header (_ value))
              (cond
                [(string->number (bytes->string/utf-8 value))
-                => (lambda (len) 
+                => (lambda (len)
                      (let ([raw-bytes (read-bytes len in)])
                        (values (delay (parse-bindings raw-bytes)) raw-bytes)))]
                [else 
                 (network-error 'read-bindings "Post request contained a non-numeric content-length")])]
             [#f
-             (let ([raw-bytes (apply bytes-append (read-to-eof in))])
-               (values (delay (parse-bindings raw-bytes)) raw-bytes))])]))]
-    [(bytes-ci=? #"PUT" meth)
+             (values (delay empty) #f)])]))]
+    [meth
      (local
        [(define content-type (headers-assq* #"Content-Type" headers))
         (define in (connection-i-port conn))]
@@ -228,12 +227,9 @@
                       (let ([raw-bytes (read-bytes len in)])
                         (values (delay empty) raw-bytes)))]
                 [else
-                 (network-error 'read-bindings "Put request contained a non-numeric content-length")])]
+                 (network-error 'read-bindings "Non-GET/POST request contained a non-numeric content-length")])]
          [#f
-          (let ([raw-bytes (apply bytes-append (read-to-eof in))])
-            (values (delay empty) raw-bytes))]))]
-    [meth
-     (values (delay empty) #f)]))
+          (values (delay empty) #f)]))]))
 
 ;; parse-bindings : bytes? -> (listof binding?)
 (define (parse-bindings raw)