58 lines
1.7 KiB
Common Lisp
58 lines
1.7 KiB
Common Lisp
;;;; cl-scopes/web/server - web server functionality
|
|
|
|
(defpackage :scopes/web/server
|
|
(:use :common-lisp)
|
|
(:local-nicknames (:config :scopes/config)
|
|
(:core :scopes/core))
|
|
(:export #:config #:address #:port #:routes
|
|
#:*listener* #:setup #:start #:stop))
|
|
|
|
(in-package :scopes/web/server)
|
|
|
|
(defclass config (config:base)
|
|
((config:env-slots :initform '(address port))
|
|
(config:setup :initform #'setup)
|
|
(address :reader address :initarg :address :initform "localhost")
|
|
(port :reader port :initarg :port :initform "8888")
|
|
(routes :reader routes :initarg :routes :initform nil)))
|
|
|
|
;;;; listener = server process
|
|
|
|
(defun app (ctx env)
|
|
(funcall (select-app ctx 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 select-app (ctx env)
|
|
#'(lambda () (message-handler ctx env)))
|
|
|
|
(defun match (pattern path))
|
|
|
|
;;;; server context (= service)
|
|
|
|
(defclass context (core:context)
|
|
((listener :accessor listener)))
|
|
|
|
(defun setup (cfg)
|
|
(let ((ctx (make-instance 'context :config cfg :name (config:name cfg))))
|
|
(start ctx)
|
|
ctx))
|