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 ++++++++--------------------------------------------------
 lazybones.asd  |  4 +--
 lazybones.lisp | 23 ++++++++++------
 package.lisp   |  2 +-
 4 files changed, 29 insertions(+), 84 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
 
diff --git a/lazybones.asd b/lazybones.asd
index 035f675..1d7d578 100644
--- a/lazybones.asd
+++ b/lazybones.asd
@@ -4,15 +4,15 @@
   :description "http route handling"
   :author "Colin Okay <cbeok@protonmail.com>"
   :license  "AGPLv3"
-  :version "0.1.0"
+  :version "0.2.0"
   :serial t
   :depends-on (#:clack
+               #:hunchentoot ;; temporary
                #:jonathan
                #:alexandria
                #:split-sequence
                #:do-urlencode
                #:arrows
-               #:parzival
                #:uiop
                #:cl-fad)
   :components ((:file "package")
diff --git a/lazybones.lisp b/lazybones.lisp
index 855f2d1..2d4ca41 100644
--- a/lazybones.lisp
+++ b/lazybones.lisp
@@ -2,6 +2,8 @@
 
 (in-package #:lazybones)
 
+(clack.util:find-handler :hunchentoot) ;; temporary
+
 ;;; SPECIAL VARS
 
 (defvar *handler* nil
@@ -322,12 +324,12 @@ CURRENT-HANDLER, allowing for non-local exits via (RETURN-FROM CURRENT-HANDLER .
          (key (path-to-route-key method path))
          (block-label (gensym "HANDLER"))
          (body-block `(block ,block-label
-                       (flet ((http-ok (content-type &rest content)
-                                (return-from ,block-label
-                                  (apply #'http-ok content-type content)))
-                              (http-err (code text)
-                                (return-from ,block-label
-                                  (funcall #'http-err code text))))
+                        (flet ((http-ok (content-type &rest content)
+                                 (return-from ,block-label
+                                   (apply #'http-ok content-type content)))
+                               (http-err (code text)
+                                 (return-from ,block-label
+                                   (funcall #'http-err code text))))
                          ,@body))))
     
     (if (member method '(:post :put :patch))
@@ -389,6 +391,9 @@ for the request's path."
     ;; otherwise
     (values nil nil)))
 
+(defvar *debugging* nil
+  "Set to T to allow the main thread to drop into the debugger when
+  errors are encountered")
 
 (defun main-handler (*req*)
   (when *logging-p*
@@ -399,13 +404,15 @@ for the request's path."
             (apply handler *req* args)
             (http-err 404 "Not Found")))
     (error (e)
-      (print e *error-output* )
+      (if *debugging*
+          (invoke-debugger e)
+          (print e *error-output* ))
       (http-err 500 "Internal Server Error"))))
 
 
 
 (defun start (&key (port 5000))
-  (setf *handler* (clack:clackup #'main-handler :port port)))
+  (setf *handler* (clack:clackup 'main-handler :port port)))
 
 (defun stop ()
   (when *handler*
diff --git a/package.lisp b/package.lisp
index 3cefcea..045a5be 100644
--- a/package.lisp
+++ b/package.lisp
@@ -33,7 +33,7 @@
    ))
 
 (defpackage #:lazybones.decoders
-  (:use #:cl #:parzival)
+  (:use #:cl)
   (:import-from #:split-sequence
                 #:split-sequence)
   (:import-from #:arrows
-- 
cgit v1.2.3