[plt-scheme] Request for small API change in web-server request structure

Hi everyone,

Noel's XMLRPC client has to go through some ugly kludges to try to get 
around a fundamental API problem in web-server.  I'd like to propose a 
fix.

Currently, here's what's going when his code needs to decode the XMLRPC 
payload:

;; Within xmlrpc's server-core.ss
   (define (extract-xmlrpc-bindings request)
     (let ([raw-bindings (request-bindings/raw request)])
       ;; This string-append is because the bindings come in
       ;; mangled for XML-RPC content; it seems like the webserver
       ;; tears it up in a syntactically bogus location (w.r.t. the
       ;; structure of the XML document.)
       (apply string-append
              (map (lambda (b)
                     (format "~a~a"
                             (binding-id b)
                             (binding:form-value b)))
                   raw-bindings))))

Unfortunately, the comment is all too true: it is fundamentally wrong to 
try to reconstruct the payload from the bindings this way, because some of 
the POST content in the payload gets munged by processes such as 
form-urlencoded-decode.  Concretely, plus signs in the payload get munged 
into spaces.  It's not an invertable process.  I fought with this for 
about ten minutes before finally realizing I was being silly.

I'm proposing adding in another field into request structures called 
post-data/raw.  I've attached a diff that does the necessary work to store 
the raw bytes that are otherwise parsed as bindings.


Would this be acceptable?  If so, then Noel can get rid of that ugly 
kludge in the server-core, and I'll be able to actually send off XMLRPC 
messages with the content "(+ 1 2)" ... *grin*
-------------- next part --------------
Index: request-structs.ss
===================================================================
--- request-structs.ss	(revision 4477)
+++ request-structs.ss	(working copy)
@@ -37,11 +37,12 @@
                                    [filename bytes?]
                                    [content bytes?])])
   
-  (define-struct request (method uri headers/raw bindings/raw
+  (define-struct request (method uri headers/raw bindings/raw post-data/raw
                                  host-ip host-port client-ip))
   (provide/contract
    [struct request ([method symbol?] [uri url?] 
                                      [headers/raw (listof header?)]
                                      [bindings/raw (listof binding?)]
+                                     [post-data/raw (or/c false/c bytes?)]
                                      [host-ip string?] [host-port number?]
                                      [client-ip string?])]))
\ No newline at end of file
Index: private/request.ss
===================================================================
--- private/request.ss	(revision 4477)
+++ private/request.ss	(working copy)
@@ -27,10 +27,10 @@
          (read-headers ip))
        (define-values (host-ip client-ip)
          (port-addresses ip))
-       (define bindings
-         (read-bindings conn method uri headers))
+       (define-values (bindings raw-post-data)
+         (read-bindings&post-data/raw conn method uri headers))
        (values
-        (make-request method uri headers bindings
+        (make-request method uri headers bindings raw-post-data
                       host-ip host-port client-ip)
         (close-connection? headers major minor
                            client-ip host-ip)))))
@@ -134,47 +134,52 @@
   
   (define FILE-FORM-REGEXP (byte-regexp #"multipart/form-data; *boundary=(.*)"))
   
-  ;; read-bindings: connection symbol url (listof header?) -> (or/c (listof binding?) string?)
-  (define (read-bindings conn meth uri headers)
+  ;; read-bindings&post-data/raw: connection symbol url (listof header?) -> (values (or/c (listof binding?) string?) (or/c bytes? false/c?))
+  (define (read-bindings&post-data/raw conn meth uri headers)
     (match meth
       ['get
-       (map (match-lambda
-              [(list-rest k v)
-               (make-binding:form (string->bytes/utf-8 (symbol->string k))
-                                  (string->bytes/utf-8 v))])
-            (url-query uri))]
+        (values (map (match-lambda
+                       [(list-rest k v)
+                        (make-binding:form (string->bytes/utf-8 (symbol->string k))
+                                           (string->bytes/utf-8 v))])
+                     (url-query uri))
+                #f)]
       ['post
-       (define content-type (headers-assq #"Content-Type" headers))
-       (define in (connection-i-port conn))
-       (cond
-         [(and content-type (regexp-match FILE-FORM-REGEXP (header-value content-type)))
-          => (match-lambda
-               [(list _ content-boundary)
-                (map (match-lambda
-                       [(struct mime-part (headers contents))
-                        (define rhs (header-value (headers-assq #"Content-Disposition" headers)))
-                        (match (list (regexp-match #"filename=(\"([^\"]*)\"|([^ ;]*))" rhs)
-                                     (regexp-match #"[^e]name=(\"([^\"]*)\"|([^ ;]*))" rhs))
-                          [(list #f #f)
-                           (network-error 'reading-bindings "Couldn't extract form field name for file upload")]
-                          [(list #f (list _ _ f0 f1))
-                           (make-binding:form (or f0 f1) (apply bytes-append contents))]
-                          [(list (list _ _ f00 f01) (list _ _ f10 f11))
-                           (make-binding:file (or f10 f11) (or f00 f01) (apply bytes-append contents))])])
-                     (read-mime-multipart content-boundary in))])]
-         [else
-          (match (headers-assq #"Content-Length" headers)
-            [(struct header (_ value))
-             (cond
-               [(string->number (bytes->string/utf-8 value))
-                => (lambda (len) 
-                     (parse-bindings (read-bytes len in)))]
-               [else 
-                (network-error 'read-bindings "Post request contained a non-numeric content-length")])]
-            [#f
-             (parse-bindings (apply bytes-append (read-to-eof in)))])])]
+        (define content-type (headers-assq #"Content-Type" headers))
+        (define in (connection-i-port conn))
+        (cond
+          [(and content-type (regexp-match FILE-FORM-REGEXP (header-value content-type)))
+           => (match-lambda
+                [(list _ content-boundary)
+                 (values
+                  (map (match-lambda
+                         [(struct mime-part (headers contents))
+                          (define rhs (header-value (headers-assq #"Content-Disposition" headers)))
+                          (match (list (regexp-match #"filename=(\"([^\"]*)\"|([^ ;]*))" rhs)
+                                       (regexp-match #"[^e]name=(\"([^\"]*)\"|([^ ;]*))" rhs))
+                            [(list #f #f)
+                             (network-error 'reading-bindings "Couldn't extract form field name for file upload")]
+                            [(list #f (list _ _ f0 f1))
+                             (make-binding:form (or f0 f1) (apply bytes-append contents))]
+                            [(list (list _ _ f00 f01) (list _ _ f10 f11))
+                             (make-binding:file (or f10 f11) (or f00 f01) (apply bytes-append contents))])])
+                       (read-mime-multipart content-boundary in))
+                  #f)])]
+          [else
+           (match (headers-assq #"Content-Length" headers)
+             [(struct header (_ value))
+              (cond
+                [(string->number (bytes->string/utf-8 value))
+                 => (lambda (len) 
+                      (let ([raw-bytes (read-bytes len in)])
+                        (values (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))])
+                (parse-bindings raw-bytes))])])]
       [meth
-       empty]))
+       (values empty #f)]))
   
   ;; parse-bindings : bytes? -> (listof binding?)
   (define (parse-bindings raw)