From be72d1475bda1256670b9ae644ccf26b3e29a400 Mon Sep 17 00:00:00 2001
From: Marc Burns <marc@localhost.localdomain>
Date: Mon, 27 Aug 2012 20:40:38 -0700
Subject: [PATCH] Include bindings via query string in POST request bindings.

The original implementation does not generate bindings from
the URL query string on POST requests. However, it is often
necessary to retrieve information from the query string on
a POST.
---
 collects/web-server/http/request.rkt | 25 +++++++++++++------------
 1 file changed, 13 insertions(+), 12 deletions(-)

diff --git a/collects/web-server/http/request.rkt b/collects/web-server/http/request.rkt
index ceba2931a1..518555ea15 100644
--- a/collects/web-server/http/request.rkt
+++ b/collects/web-server/http/request.rkt
@@ -218,18 +218,19 @@
 
 ;; read-bindings&post-data/raw: input-port symbol url (listof header?) -> (values (or/c (listof binding?) string?) (or/c bytes? false/c?))
 (define (read-bindings&post-data/raw in meth uri headers)
+  (define bindings-GET
+   (delay
+     (filter-map
+      (match-lambda
+       [(list-rest k v)
+        (if (and (symbol? k) (string? v))
+          (make-binding:form (string->bytes/utf-8 (symbol->string k))
+                             (string->bytes/utf-8 v))
+          #f)])
+      (url-query uri))))
   (cond
     [(bytes-ci=? #"GET" meth)
-     (values (delay
-               (filter-map 
-                (match-lambda
-                 [(list-rest k v)
-                  (if (and (symbol? k) (string? v))
-                    (make-binding:form (string->bytes/utf-8 (symbol->string k))
-                                       (string->bytes/utf-8 v))
-                    #f)])
-                (url-query uri)))
-             #f)]
+     (values bindings-GET #f)]
     [(bytes-ci=? #"POST" meth)
      (define content-type (headers-assq* #"Content-Type" headers))
      (cond
@@ -264,7 +265,7 @@
                                             (apply bytes-append contents))])])
                     (read-mime-multipart content-boundary in)))
              (values
-              (delay bs)
+              (delay (append (force bindings-GET) bs))
               #f)])]
        [else        
         (match (headers-assq* #"Content-Length" headers)
@@ -273,7 +274,7 @@
              [(string->number (bytes->string/utf-8 value))
               => (lambda (len)
                    (let ([raw-bytes (read-bytes len in)])
-                     (values (delay (parse-bindings raw-bytes)) raw-bytes)))]
+                     (values (delay (append (parse-bindings raw-bytes) (force bindings-GET))) raw-bytes)))]
              [else 
               (network-error
                'read-bindings