diff options
Diffstat (limited to 'decoders.lisp')
| -rw-r--r-- | decoders.lisp | 84 |
1 files changed, 11 insertions, 73 deletions
diff --git a/decoders.lisp b/decoders.lisp index c75a323..7f581a5 100644 --- a/decoders.lisp +++ b/decoders.lisp @@ -50,79 +50,17 @@ ;;; MULTIPART/FORM-DATA DECODER -(<<def <crlf< (<<and (<<char #\Return) - (<<char #\Newline)) - "Matches the standard CRLF line ending used by HTTP") - - -(<<def <word-plus< - (<<to-string (<<+ (<<or <alphanum< (<<any-char "-_/. ")))) - "parses a word like foo-bar or foo-bar-zoo4") - - -(<<def <key-equal-val< - (<<let ((key (<<and <whitespace< <word-plus<)) - (val (<<and (<<char #\=) - (<<char-brackets #\" <word-plus< #\")))) - (<<result (list (make-keyword key) val))) - "Parses strings that look like foo-bar=\"goo\" and returns a list (:foo-bar \"goo\")") - - -(<<def <multipart-header-content-disposition< - (<<map - (lambda (pairs) (apply 'append pairs)) - (<<and (<<string "Content-Disposition: form-data; ") - (<<sep-by <key-equal-val< (<<string "; ")))) - - "Parses a Content-Disposition header in a multipart/form-data block. -Returns a PLIST with one property, the value of which is also a PLIST. - -E.g. Content-Disposition: form-data; name=\"file\"; filename=\"mypic.png\" -becomes (:content-disposition (:name \"file\" :filename \"mypic.png\"))") - -(<<def <multipart-header< - (<<let ((header <word-plus<) - (value (<<map #'butlast-to-string - (<<and (<<char #\:) - (<<until <crlf<))))) - (<<result (list (make-keyword header) - (string-trim '(#\Space) value))))) - - - - -(defun <<multipart/form-data-part (stop-seq) - (<<let ((disp (<<and (<<? <crlf<) - <multipart-header-content-disposition<)) - (headers (<<and <crlf< (<<* <multipart-header<))) - (body (<<and <crlf< - (<<map #'butlast-to-string - (<<until (<<and <crlf< - (<<string stop-seq))))))) - (<<result - (let ((all-headers (nconc disp (apply 'append headers)))) - (if (binary-content-p (getf all-headers :content-type)) - (nconc all-headers (list :body (write-binary-to-tmp-file body))) - (nconc all-headers (list :body body))))))) - - - -(defun <<multipart/form-data (boundary) - (<<let ((parts (<<and (<<string boundary) - <crlf< - (<<+ (<<multipart/form-data-part boundary)))) - (_ending (<<and (<<string "--") <crlf<)) ) - (<<result parts))) - -(defun decode-multipart/form-data (stream content-type content-length) - (let* ((boundary (concatenate 'string - "--" - (second (split-sequence:split-sequence #\= content-type)))) - (stream (make-instance 'replay-streams:static-text-replay-stream - :text (read-body-to-string stream content-length)))) - (parse stream (<<multipart/form-data boundary)))) - -(add-decoder "multipart/form-data" #'decode-multipart/form-data) +;; Temporarily justing the hunchentoot post-parameter feature +(add-decoder "multipart/form-data" + (lambda (&rest ignore) + (declare (ignore ignore)) + (loop :for (k . v) :in (hunchentoot:post-parameters*) + :when (and (listp v) (= 3 (length v))) + :collect (list :name k + :body (first v) + :filename (second v) + :content-type (third v)) + :collect (list :name k :body v)))) ;;; APPLICATION/X-WWW-FORM-URLENCODED |