aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorColin Okay <okay@toyful.space>2020-12-21 09:01:46 -0600
committerColin Okay <okay@toyful.space>2020-12-21 09:01:46 -0600
commite156fe7e15e236f11ffb8828273d4014db156d2f (patch)
tree5b4fd66de67f8186a58a7296302c1a4e1769e3f5
parentb7c6f7e5f5397026a6ecc1ffc2aa7d0b82d58816 (diff)
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.
-rw-r--r--decoders.lisp84
-rw-r--r--lazybones.asd4
-rw-r--r--lazybones.lisp23
-rw-r--r--package.lisp2
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