diff options
| -rw-r--r-- | routes.asd | 1 | ||||
| -rw-r--r-- | src/package.lisp | 6 | ||||
| -rw-r--r-- | src/routes.lisp | 28 |
3 files changed, 22 insertions, 13 deletions
@@ -6,6 +6,7 @@ :version "1.0.0" :serial t :depends-on (:alexandria + :quri :split-sequence :usocket-server) :pathname "src" diff --git a/src/package.lisp b/src/package.lisp index 91b354b..38a67f7 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -3,4 +3,8 @@ #:alexandria #:split-sequence) (:export #:define-route - #:server)) + #:server + + #:request-method + #:request-route + #:request-uri)) diff --git a/src/routes.lisp b/src/routes.lisp index 9cef55d..502afca 100644 --- a/src/routes.lisp +++ b/src/routes.lisp @@ -28,24 +28,25 @@ :finally (return (values declarations body))))) -(defmacro define-route (name (headers &key uri method content-type) &body body) +(defmacro define-route (name (headers &key route method content-type) &body body) "Define function NAME with BODY, which takes HEADERS and URI-BINDINGS and handles a SCGI request. Also add entry to *ROUTES-TABLE* with the URI path of the route and the METHOD it handles. METHOD may be a keyword or a list of keywords." - (let ((uri-bindings (gensym))) - (flet ((binding (name) `(,name (assoc-value ,uri-bindings ',name)))) + (let ((route-bindings (gensym))) + (flet ((binding (name) `(,name (assoc-value ,route-bindings ',name)))) (multiple-value-bind (declarations body) (split-declarations body) `(progn (let ((entry (assoc ',name *routes-table*))) (if entry - (setf (second entry) ,(ensure-list method) - (third entry) ,uri) - (push '(,name ,(ensure-list method) ,uri) *routes-table*))) - (defun ,name (,headers ,uri-bindings) + (setf (second entry) ',(ensure-list method) + (third entry) ',route) + (push '(,name ,(ensure-list method) ,route) *routes-table*))) + (defun ,name (,headers ,route-bindings) ,@declarations + (declare (ignorable ,route-bindings)) (write-string (http-response-header ,content-type)) - (let (,@(mapcar #'binding (remove-if-not #'symbolp uri))) + (let (,@(mapcar #'binding (remove-if-not #'symbolp route))) ,@body))))))) (defun match-route (pattern route) @@ -100,8 +101,11 @@ header." ("POST" :post))) (defun request-uri (headers) - (split-sequence #\/ (assoc-value headers :request-uri) - :remove-empty-subseqs t)) + (quri:uri (assoc-value headers :request-uri))) + +(defun request-route (headers) + (let ((uri (request-uri headers))) + (split-sequence #\/ (quri:uri-path uri) :remove-empty-subseqs t))) (defun serve-request (stream error-handler) "Read SCGI header from STREAM and look for and call function handling matching @@ -114,10 +118,10 @@ route. If no route matches, then ERROR-HANDLER is called." ;; Read trailing #\Nul (read-char stream) (let ((headers (parse-headers buffer))) - (let ((uri (request-uri headers)) + (let ((route (request-route headers)) (method (request-method headers))) (multiple-value-bind (entry bindings) - (find-route uri method *routes-table*) + (find-route route method *routes-table*) (if entry (funcall (first entry) headers bindings) (funcall error-handler headers))))))) |