diff options
| -rw-r--r-- | README.md | 9 | ||||
| -rw-r--r-- | decoders.lisp | 84 | ||||
| -rw-r--r-- | lazybones.asd | 4 | ||||
| -rw-r--r-- | lazybones.lisp | 23 | ||||
| -rw-r--r-- | package.lisp | 2 |
5 files changed, 31 insertions, 91 deletions
@@ -82,18 +82,13 @@ For example: # Installation If you insist on trying `lazybones` for yourself, you'll need to -ensure that your quicklisp can find - -- [parzival](https://github.com/cbeo/parzival) parser framework, for decoding request bodies -- [replay-streams](https://github.com/cbeo/replay-streams) a dependency of parzival +ensure that your quicklisp can find it. The easiest approach is probably something like: cd ~/quicklisp/local-projects/ - git clone https://github.com/cbeo/parzival - git clone https://github.com/cbeo/replay-streams - git clone https://github.com/cbeo/lazybones + git clone https://github.com/cbeo/lazybones With those packages available to quicklisp, you should be able to do `(ql:quickload :lazybones)` in your REPL. 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 |