[racket] web server: CRUD put/delete?
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)])]))