From e156fe7e15e236f11ffb8828273d4014db156d2f Mon Sep 17 00:00:00 2001
From: Colin Okay <okay@toyful.space>
Date: Mon, 21 Dec 2020 09:01:46 -0600
Subject: removed dep on parzival, introduced dep on hunchentoot

hopefully the hunchentoot dep is temporary.

I had to patch over my ill-conceived multipart form decoder.
---
 decoders.lisp | 84 ++++++++---------------------------------------------------
 1 file changed, 11 insertions(+), 73 deletions(-)

(limited to 'decoders.lisp')

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
 
-- 
cgit v1.2.3