[racket] web server: CRUD put/delete?

From: George Neuner (gneuner2 at comcast.net)
Date: Thu Dec 4 20:23:22 EST 2014

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)])]))






Posted on the users mailing list.