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

server: work in progress: basic routing to message handler or fileserver

Browse source
This commit is contained in:
Helmut Merz 2024-06-23 10:39:15 +02:00
parent 9a91a59247
commit d894a861b2
3 changed files with 34 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
scopes-web.asd
View file

@ -6,7 +6,7 @@
:version "0.0.1" :version "0.0.1"
:homepage "https://www.cyberconcepts.org" :homepage "https://www.cyberconcepts.org"
:description "Web client and server functionality." :description "Web client and server functionality."
:depends-on (:clack :dexador :lack :depends-on (:clack :dexador :lack :lack-component :lack-app-file
:scopes-core) :scopes-core)
:components ((:file "web/client") :components ((:file "web/client")
(:file "web/server")) (:file "web/server"))

5
test/test-web.lisp
View file

@ -17,15 +17,14 @@
(defun run () (defun run ()
(let ((t:*test-suite* (t:test-suite "web")) (let ((t:*test-suite* (t:test-suite "web"))
(*config* nil) (*config* nil))
(server:*listener* nil))
(load (t:test-path "config-web" "etc")) (load (t:test-path "config-web" "etc"))
(core:setup-services *config*) (core:setup-services *config*)
(test-server-config) (test-server-config)
(sleep 0.1) (sleep 0.1)
(test-client) (test-client)
(sleep 0.1) (sleep 0.1)
(server:stop) (server:stop (core:find-service :server))
(t:show-result))) (t:show-result)))
(t:deftest test-server-config () (t:deftest test-server-config ()

47
web/server.lisp
View file

@ -4,7 +4,7 @@
(:use :common-lisp) (:use :common-lisp)
(:local-nicknames (:config :scopes/config) (:local-nicknames (:config :scopes/config)
(:core :scopes/core)) (:core :scopes/core))
(:export #:config #:address #:port (:export #:config #:address #:port #:routes
#:*listener* #:setup #:start #:stop)) #:*listener* #:setup #:start #:stop))
(in-package :scopes/web/server) (in-package :scopes/web/server)
@ -13,31 +13,46 @@
((config:env-slots :initform '(address port)) ((config:env-slots :initform '(address port))
(config:setup :initform #'setup) (config:setup :initform #'setup)
(address :reader address :initarg :address :initform "localhost") (address :reader address :initarg :address :initform "localhost")
(port :reader port :initarg :port :initform "8888"))) (port :reader port :initarg :port :initform "8888")
(routes :reader routes :initarg :routes :initform nil)))
;;;; listener = server process ;;;; listener = server process
(defvar *listener* nil) (defun app (ctx env)
(funcall (select-app ctx env)))
(defun app (env) (defun start (ctx)
(let ((cfg (core:config ctx)))
(setf (listener ctx)
(clack:clackup #'(lambda (env) (app ctx env))
:port (parse-integer (port cfg))
:address (address cfg)
:silent t))))
(defun stop (ctx)
(clack:stop (listener ctx)))
(defun fileserver (ctx env doc-root)
(let* ((rel-path (str:join "/" (getf env :messaage-head)))
(file-app (make-instance 'lack/app/file:lack-app-file
:file rel-path :root doc-root)))
(lack/component:call file-app env)))
(defun message-handler (ctx env)
(print env) (print env)
'(200 (:content-type "text/plain") ("Hello World!"))) '(200 (:content-type "text/plain") ("Hello World!")))
(defun start (cfg) (defun select-app (ctx env)
(setf *listener* #'(lambda () (message-handler ctx env)))
(clack:clackup #'app
:port (parse-integer (port cfg))
:address (address cfg)
:silent t)))
(defun stop () (defun match (pattern path))
(clack:stop *listener*))
;;;; server context (= service) ;;;; server context (= service)
(defclass context (core:context) ()) (defclass context (core:context)
((listener :accessor listener)))
(defun setup (cfg) (defun setup (cfg)
(prog1 (let ((ctx (make-instance 'context :config cfg :name (config:name cfg))))
(make-instance 'context :config cfg :name (config:name cfg)) (start ctx)
(start cfg))) ctx))