From 43aa918e32c38dea829c87b44c22f252ba377611 Mon Sep 17 00:00:00 2001 From: Thomas Albers Raviola Date: Sun, 5 May 2024 16:52:57 +0200 Subject: * Export symbols. Use quri for request uris --- src/routes.lisp | 28 ++++++++++++++++------------ 1 file changed, 16 insertions(+), 12 deletions(-) (limited to 'src/routes.lisp') 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))))))) -- cgit v1.2.3