cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

web/server: routing basically working

Browse source
This commit is contained in:
Helmut Merz 2024-06-23 15:40:21 +02:00
parent 833c6d7578
commit 1f3247e1e3
4 changed files with 18 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
test/etc/config-web.lisp
View file

@ -8,8 +8,9 @@
:class 'server:config :class 'server:config
:port "8899" :port "8899"
:routes :routes
`((nil server:fileserver `((("api") server:message-handler)
:doc-root ,(t:test-path "" "docs"))))))) (() server:fileserver
:doc-root ,(t:test-path "" "docs")))))))
(let ((cfg (config:add *config* :client (let ((cfg (config:add *config* :client
:class 'client:config :class 'client:config

2
test/test-web.lisp
View file

@ -25,7 +25,7 @@
(test-server-config server) (test-server-config server)
(sleep 0.1) (sleep 0.1)
(test-fileserver client) (test-fileserver client)
;(test-message client) (test-message client)
(sleep 0.1) (sleep 0.1)
(server:stop (core:find-service :server)) (server:stop (core:find-service :server))
(t:show-result)))) (t:show-result))))

6
web/client.lisp
View file

@ -26,5 +26,9 @@
(defun send-message (ctx msg) (defun send-message (ctx msg)
(let* ((cfg (core:config ctx)) (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))) (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))))

14
web/server.lisp
View file

@ -35,7 +35,7 @@
(defun fileserver (ctx env &key doc-root) (defun fileserver (ctx env &key doc-root)
(let* ((message-head (getf env :message-head)) (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-app (make-instance 'lack/app/file:lack-app-file
:file rel-path :root doc-root))) :file rel-path :root doc-root)))
;(format t "~&file path: ~s~%" (merge-pathnames rel-path doc-root)) ;(format t "~&file path: ~s~%" (merge-pathnames rel-path doc-root))
@ -46,10 +46,10 @@
'(200 (:content-type "text/plain") ("Hello World!"))) '(200 (:content-type "text/plain") ("Hello World!")))
(defun select-app (ctx env) (defun select-app (ctx env)
(dolist (r (routes (core:config ctx))) (let ((path (cdr (str:split "/" (getf env :path-info)))))
(if (match (car r) nil) (dolist (r (routes (core:config ctx)))
(progn (when (match (car r) path)
(setf (getf env :message-head) (str:split "/" (getf env :path-info))) (setf (getf env :message-head) (nthcdr (length (car r)) path))
;(format t "~&route: ~s~%" r) ;(format t "~&route: ~s~%" r)
(return-from select-app (return-from select-app
#'(lambda () #'(lambda ()
@ -57,6 +57,10 @@
#'(lambda () (message-handler ctx env))) #'(lambda () (message-handler ctx env)))
(defun match (pattern path) (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) t)
;;;; server context (= service) ;;;; server context (= service)