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

web/server: first basically working fileserver

Browse source
This commit is contained in:
Helmut Merz 2024-06-23 12:05:50 +02:00
parent d894a861b2
commit 504aaf0f92
3 changed files with 24 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
test/docs/demo.html Normal file
View file

@ -0,0 +1 @@
Hello Fileserver!

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

@ -6,7 +6,10 @@
(let ((cfg (config:add *config* :server
:class 'server:config
:port "8899"))))
:port "8899"
:routes
`((nil server:fileserver
:doc-root ,(t:test-path "" "docs")))))))
(let ((cfg (config:add *config* :client
:class 'client:config

23
web/server.lisp
View file

@ -5,7 +5,8 @@
(:local-nicknames (:config :scopes/config)
(:core :scopes/core))
(:export #:config #:address #:port #:routes
#:*listener* #:setup #:start #:stop))
#:*listener* #:setup #:start #:stop
#:fileserver #:message-handler))
(in-package :scopes/web/server)
@ -32,10 +33,15 @@
(defun stop (ctx)
(clack:stop (listener ctx)))
(defun fileserver (ctx env doc-root)
(let* ((rel-path (str:join "/" (getf env :messaage-head)))
(defun fileserver (ctx env &key doc-root)
(print env)
(let* ((message-head (getf env :message-head))
(rel-path (str:join "/" (cdr message-head)))
(file-app (make-instance 'lack/app/file:lack-app-file
:file rel-path :root doc-root)))
(format t "~&fileserver: doc-root ~s, rel-path ~s, message-head ~s~%"
doc-root rel-path message-head)
(format t "~&file path: ~s~%" (merge-pathnames rel-path doc-root))
(lack/component:call file-app env)))
(defun message-handler (ctx env)
@ -43,9 +49,18 @@
'(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)))
(format t "~&route: ~s~%" r)
(return-from select-app
#'(lambda ()
(apply (cadr r) ctx env (cddr r)))))))
#'(lambda () (message-handler ctx env)))
(defun match (pattern path))
(defun match (pattern path)
t)
;;;; server context (= service)