diff --git a/test/etc/config-web.lisp b/test/etc/config-web.lisp index c4faa00..52f809b 100644 --- a/test/etc/config-web.lisp +++ b/test/etc/config-web.lisp @@ -8,8 +8,9 @@ :class 'server:config :port "8899" :routes - `((nil server:fileserver - :doc-root ,(t:test-path "" "docs"))))))) + `((("api") server:message-handler) + (() server:fileserver + :doc-root ,(t:test-path "" "docs"))))))) (let ((cfg (config:add *config* :client :class 'client:config diff --git a/test/test-web.lisp b/test/test-web.lisp index e3e8120..a32025a 100644 --- a/test/test-web.lisp +++ b/test/test-web.lisp @@ -25,7 +25,7 @@ (test-server-config server) (sleep 0.1) (test-fileserver client) - ;(test-message client) + (test-message client) (sleep 0.1) (server:stop (core:find-service :server)) (t:show-result)))) diff --git a/web/client.lisp b/web/client.lisp index 4bee028..ed902dc 100644 --- a/web/client.lisp +++ b/web/client.lisp @@ -26,5 +26,9 @@ (defun send-message (ctx msg) (let* ((cfg (core:config ctx)) - (url (str:concat (base-url cfg) (api-path cfg) (message:head-as-list msg)))) + (url (str:concat (base-url cfg) (api-path cfg) (msgpath msg)))) (dex:get url))) + +(defun msgpath (msg) + (let ((lst (loop for p in (message:head-as-list msg) when p collect p))) + (str:join "/" (mapcar #'string-downcase lst)))) diff --git a/web/server.lisp b/web/server.lisp index aae53e6..e524da6 100644 --- a/web/server.lisp +++ b/web/server.lisp @@ -35,7 +35,7 @@ (defun fileserver (ctx env &key doc-root) (let* ((message-head (getf env :message-head)) - (rel-path (str:join "/" (cdr message-head))) + (rel-path (str:join "/" message-head)) (file-app (make-instance 'lack/app/file:lack-app-file :file rel-path :root doc-root))) ;(format t "~&file path: ~s~%" (merge-pathnames rel-path doc-root)) @@ -46,10 +46,10 @@ '(200 (:content-type "text/plain") ("Hello World!"))) (defun select-app (ctx env) - (dolist (r (routes (core:config ctx))) - (if (match (car r) nil) - (progn - (setf (getf env :message-head) (str:split "/" (getf env :path-info))) + (let ((path (cdr (str:split "/" (getf env :path-info))))) + (dolist (r (routes (core:config ctx))) + (when (match (car r) path) + (setf (getf env :message-head) (nthcdr (length (car r)) path)) ;(format t "~&route: ~s~%" r) (return-from select-app #'(lambda () @@ -57,6 +57,10 @@ #'(lambda () (message-handler ctx env))) (defun match (pattern path) + ;(format t "~&match: pattern ~s, p ~s" pattern p) + (dolist (e pattern) + (unless (string= e (pop path)) + (return-from match nil))) t) ;;;; server context (= service)