From 545009a48a7afbfd3c35d5681e073b41842ff2f6 Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Fri, 25 Jan 2013 06:50:00 -0700
Subject: [PATCH] Catching contract violation error discovered by Danny Yoo

---
 collects/tests/web-server/pr/cl-long.rkt | 14 ++++++++++++++
 collects/web-server/http/request.rkt     | 20 ++++++++++++++++++--
 2 files changed, 32 insertions(+), 2 deletions(-)
 create mode 100644 collects/tests/web-server/pr/cl-long.rkt

diff --git a/collects/tests/web-server/pr/cl-long.rkt b/collects/tests/web-server/pr/cl-long.rkt
new file mode 100644
index 0000000000..19304ecca3
--- /dev/null
+++ b/collects/tests/web-server/pr/cl-long.rkt
@@ -0,0 +1,14 @@
+#lang racket/base
+(require web-server/http
+         web-server/http/request
+         web-server/http/bindings
+         rackunit
+         "../util.rkt")
+
+(define request-bs
+  #"POST /xapps/agent-stat HTTP/1.1\r\nUser-Agent: curl/7.21.6 (x86_64-pc-linux-gnu) libcurl/7.21.6 OpenSSL/1.0.0e zlib/1.2.3.4 libidn/1.22 librtmp/2.3\r\nHost: localhost:8080\r\nAccept: */*\r\nContent-Length: 95\r\nContent-Type: application/x-www-form-urlencoded\r\n\r\n")
+
+(define-values (conn ip op)
+  (make-mock-connection request-bs))
+(check-exn (λ (x) (regexp-match #rx"Post data" (exn-message x)))
+           (λ () (read-request conn 80 (λ _ (values "to" "from")))))
diff --git a/collects/web-server/http/request.rkt b/collects/web-server/http/request.rkt
index a2ce2ac584..fee9d928a9 100644
--- a/collects/web-server/http/request.rkt
+++ b/collects/web-server/http/request.rkt
@@ -274,7 +274,17 @@
              [(string->number (bytes->string/utf-8 value))
               => (lambda (len)
                    (let ([raw-bytes (read-bytes len in)])
-                     (values (delay (append (parse-bindings raw-bytes) (force bindings-GET))) raw-bytes)))]
+                     (cond
+                       [(eof-object? raw-bytes)
+                        (network-error
+                         'read-bindings
+                         "Post data ended pre-maturely")]
+                       [else
+                        (values (delay 
+                                  (append
+                                   (parse-bindings raw-bytes)
+                                   (force bindings-GET)))
+                                raw-bytes)])))]
              [else 
               (network-error
                'read-bindings
@@ -288,7 +298,13 @@
         (cond [(string->number (bytes->string/utf-8 value))
                => (lambda (len)
                     (let ([raw-bytes (read-bytes len in)])
-                      (values (delay empty) raw-bytes)))]
+                      (cond
+                        [(eof-object? raw-bytes)
+                         (network-error
+                          'read-bindings
+                          "Post data ended pre-maturely")]
+                        [else
+                         (values (delay empty) raw-bytes)])))]
               [else
                (network-error 
                 'read-bindings