server: work in progress: basic routing to message handler or fileserver
This commit is contained in:
parent
9a91a59247
commit
d894a861b2
3 changed files with 34 additions and 20 deletions
|
@ -6,7 +6,7 @@
|
|||
:version "0.0.1"
|
||||
:homepage "https://www.cyberconcepts.org"
|
||||
:description "Web client and server functionality."
|
||||
:depends-on (:clack :dexador :lack
|
||||
:depends-on (:clack :dexador :lack :lack-component :lack-app-file
|
||||
:scopes-core)
|
||||
:components ((:file "web/client")
|
||||
(:file "web/server"))
|
||||
|
|
|
@ -17,15 +17,14 @@
|
|||
|
||||
(defun run ()
|
||||
(let ((t:*test-suite* (t:test-suite "web"))
|
||||
(*config* nil)
|
||||
(server:*listener* nil))
|
||||
(*config* nil))
|
||||
(load (t:test-path "config-web" "etc"))
|
||||
(core:setup-services *config*)
|
||||
(test-server-config)
|
||||
(sleep 0.1)
|
||||
(test-client)
|
||||
(sleep 0.1)
|
||||
(server:stop)
|
||||
(server:stop (core:find-service :server))
|
||||
(t:show-result)))
|
||||
|
||||
(t:deftest test-server-config ()
|
||||
|
|
|
@ -4,7 +4,7 @@
|
|||
(:use :common-lisp)
|
||||
(:local-nicknames (:config :scopes/config)
|
||||
(:core :scopes/core))
|
||||
(:export #:config #:address #:port
|
||||
(:export #:config #:address #:port #:routes
|
||||
#:*listener* #:setup #:start #:stop))
|
||||
|
||||
(in-package :scopes/web/server)
|
||||
|
@ -13,31 +13,46 @@
|
|||
((config:env-slots :initform '(address port))
|
||||
(config:setup :initform #'setup)
|
||||
(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
|
||||
|
||||
(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)
|
||||
'(200 (:content-type "text/plain") ("Hello World!")))
|
||||
|
||||
(defun start (cfg)
|
||||
(setf *listener*
|
||||
(clack:clackup #'app
|
||||
:port (parse-integer (port cfg))
|
||||
:address (address cfg)
|
||||
:silent t)))
|
||||
(defun select-app (ctx env)
|
||||
#'(lambda () (message-handler ctx env)))
|
||||
|
||||
(defun stop ()
|
||||
(clack:stop *listener*))
|
||||
(defun match (pattern path))
|
||||
|
||||
;;;; server context (= service)
|
||||
|
||||
(defclass context (core:context) ())
|
||||
(defclass context (core:context)
|
||||
((listener :accessor listener)))
|
||||
|
||||
(defun setup (cfg)
|
||||
(prog1
|
||||
(make-instance 'context :config cfg :name (config:name cfg))
|
||||
(start cfg)))
|
||||
(let ((ctx (make-instance 'context :config cfg :name (config:name cfg))))
|
||||
(start ctx)
|
||||
ctx))
|
||||
|
|
Loading…
Add table
Reference in a new issue