[racket] web server: CRUD put/delete?
Were you not able to run my example? In the sample you sent, your
cases for delete and put are commented out.
In the code you quote, the second to last case is [meth ...] and that
handles all methods not mentioned.
Jay
On Thu, Dec 4, 2014 at 8:23 PM, George Neuner <gneuner2 at comcast.net> wrote:
> Hi Jay,
>
> Additionally, I tried to find the server dispatch code in the library.
>
> I found the code below in "request.rkt" ... I don't know if it is the right
> code, but there is no mention of PUT or DELETE.
> George
>
> -----------------------------------------
>
> ;; 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 bindings-GET #f)]
> [(bytes-ci=? #"POST" meth)
> (define content-type (headers-assq* #"Content-Type" headers))
> (cond
> [(and content-type
> (regexp-match FILE-FORM-REGEXP (header-value content-type)))
> => (match-lambda
> [(list _ content-boundary)
> ;; XXX This can't be delay because it reads from the
> ;; port, which would otherwise be closed. I think
> ;; this is reasonable because the Content-Type
> ;; said it would have this format
> (define bs
> (map (match-lambda
> [(struct mime-part (headers contents))
> (define rhs
> (header-value
> (headers-assq* #"Content-Disposition" headers)))
> (match*
> ((regexp-match #"filename=(\"([^\"]*)\"|([^ ;]*))"
> rhs)
> (regexp-match #"[^e]name=(\"([^\"]*)\"|([^ ;]*))"
> rhs))
> [(#f #f)
> (network-error
> 'reading-bindings
> "Couldn't extract form field name for file
> upload")]
> [(#f (list _ _ f0 f1))
> (make-binding:form (or f0 f1)
> (apply bytes-append contents))]
> [((list _ _ f00 f01) (list _ _ f10 f11))
> (make-binding:file (or f10 f11)
> (or f00 f01)
> headers
> (apply bytes-append
> contents))])])
> (read-mime-multipart content-boundary in)))
> (values
> (delay (append (force bindings-GET) bs))
> #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)])
> (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
> "Post request contained a non-numeric content-length")])]
> [#f
> (values (delay empty) #f)])])]
> [meth
> (define content-type (headers-assq* #"Content-Type" headers))
> (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)])
> (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
> "Non-GET/POST request contained a non-numeric
> content-length")])]
> [#f
> (values (delay empty) #f)])]))
>
>
>
>
>
--
Jay McCarthy
http://jeapostrophe.github.io
"Wherefore, be not weary in well-doing,
for ye are laying the foundation of a great work.
And out of small things proceedeth that which is great."
- D&C 64:33