From d894a861b2cf44871047ca256531d1499540bf3c Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Sun, 23 Jun 2024 10:39:15 +0200
Subject: [PATCH] server: work in progress: basic routing to message handler or
 fileserver

---
 scopes-web.asd     |  2 +-
 test/test-web.lisp |  5 ++---
 web/server.lisp    | 47 ++++++++++++++++++++++++++++++----------------
 3 files changed, 34 insertions(+), 20 deletions(-)

diff --git a/scopes-web.asd b/scopes-web.asd
index 81e1263..9090d1b 100644
--- a/scopes-web.asd
+++ b/scopes-web.asd
@@ -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"))
diff --git a/test/test-web.lisp b/test/test-web.lisp
index 5c984f8..0a9855c 100644
--- a/test/test-web.lisp
+++ b/test/test-web.lisp
@@ -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 ()
diff --git a/web/server.lisp b/web/server.lisp
index 39897ce..aed0494 100644
--- a/web/server.lisp
+++ b/web/server.lisp
@@ -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))