(require 'emacs-web-server-status-codes)
(require 'mail-parse) ; to parse multipart data in headers
(require 'mm-encode) ; to look-up mime types for files
+(require 'url-util) ; to decode url-encoded params
(require 'eieio)
(eval-when-compile (require 'cl))
(require 'cl-lib)
(mapc #'delete-process (append (mapcar #'car (clients server))
(list (process server)))))
-(defun ews-parse (string)
+(defvar ews-http-common-methods '(GET HEAD POST PUT DELETE TRACE)
+ "HTTP methods from http://www.w3.org/Protocols/rfc2616/rfc2616-sec9.html.")
+
+(defvar ews-http-method-rx
+ (format "^\\(%s\\) \\([^[:space:]]+\\) \\([^[:space:]]+\\)$"
+ (mapconcat #'symbol-name ews-http-common-methods "\\|")))
+
+(defun ews-parse (proc string)
(cl-flet ((to-keyword (s) (intern (concat ":" (upcase (match-string 1 s))))))
(cond
- ((string-match
- "^\\(GET\\|POST\\) \\([^[:space:]]+\\) \\([^[:space:]]+\\)$" string)
- (list (cons (to-keyword (match-string 1 string)) (match-string 2 string))
- (cons :TYPE (match-string 3 string))))
+ ((string-match ews-http-method-rx string)
+ (let ((method (to-keyword (match-string 1 string)))
+ (url (match-string 2 string)))
+ (if (string-match "?" url)
+ (cons (cons method (substring url 0 (match-beginning 0)))
+ (url-parse-query-string (url-unhex-string
+ (substring url (match-end 0))) ))
+ (list (cons method url)))))
((string-match "^\\([^[:space:]]+\\): \\(.*\\)$" string)
(list (cons (to-keyword string) (match-string 2 string))))
(:otherwise (ews-error proc "bad header: %S" string) nil))))
(with-slots (handler clients) (plist-get (process-plist proc) :server)
(unless (assoc proc clients)
(push (cons proc (make-instance 'ews-client)) clients))
- (let ((client (cdr (assoc proc clients))))
- (when (ews-do-filter client string)
- (when (not (eq (catch 'close-connection
- (ews-call-handler proc (cdr (headers client)) handler))
- :keep-open))
- (setq clients (assq-delete-all proc clients))
- (delete-process proc))))))
+ (let ((c (cdr (assoc proc clients))))
+ (when (not (eq (catch 'close-connection
+ (if (ews-do-filter proc c string)
+ (ews-call-handler proc (cdr (headers c)) handler)
+ :keep-open))
+ :keep-open))
+ (setq clients (assq-delete-all proc clients))
+ (delete-process proc)))))
-(defun ews-do-filter (client string)
+(defun ews-do-filter (proc client string)
"Return non-nil when finished and the client may be deleted."
(with-slots (leftover boundary headers) client
(let ((pending (concat leftover string))
(cond
;; Double \r\n outside of post data means we are done
;; w/headers and should call the handler.
- ((= last-index index)
+ ((and (not boundary) (= last-index index))
+ (throw 'finished-parsing-headers t))
+ ;; Parse a URL
+ ((eq boundary :application/x-www-form-urlencoded)
+ (mapc (lambda (pair) (setcdr (last headers) (list pair)))
+ (url-parse-query-string
+ (ews-trim (substring pending last-index))))
(throw 'finished-parsing-headers t))
;; Build up multipart data.
(boundary
(throw 'finished-parsing-headers t)))
;; Standard header parsing.
(:otherwise
- (let ((this (ews-parse (substring pending last-index index))))
+ (let ((this (ews-parse proc (substring pending last-index index))))
(if (and (caar this) (eql (caar this) :CONTENT-TYPE))
(cl-destructuring-bind (type &rest data)
(mail-header-parse-content-type (cdar this))
- (unless (string= type "multipart/form-data")
- (ews-error proc "TODO: handle content type: %S" type))
- (when (assoc 'boundary data)
- (setq boundary (cdr (assoc 'boundary data)))
- (setq delimiter (concat "\r\n--" boundary))))
+ (cond
+ ((string= type "multipart/form-data")
+ (when (assoc 'boundary data)
+ (setq boundary (cdr (assoc 'boundary data)))
+ (setq delimiter (concat "\r\n--" boundary))))
+ ((string= type "application/x-www-form-urlencoded")
+ (setq boundary (intern (concat ":" (downcase type)))))
+ (:otherwise
+ (ews-error proc "TODO: handle content type: %S" type))))
(setcdr (last headers) this)))))
(setq last-index tmp)))
(setq leftover (ews-trim (substring pending last-index)))