From be72d1475bda1256670b9ae644ccf26b3e29a400 Mon Sep 17 00:00:00 2001 From: Marc Burns 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