app/demo: fileserver (with docroot in env) basically working
This commit is contained in:
parent
ea86a2def0
commit
9da223abc6
5 changed files with 38 additions and 6 deletions
1
.gitignore
vendored
1
.gitignore
vendored
|
@ -1,3 +1,4 @@
|
||||||
test.db
|
test.db
|
||||||
bin
|
bin
|
||||||
|
.env
|
||||||
*-test.log
|
*-test.log
|
||||||
|
|
17
app/demo/etc/config.lisp
Normal file
17
app/demo/etc/config.lisp
Normal file
|
@ -0,0 +1,17 @@
|
||||||
|
;;;; cl-scopes/app/demo/etc/config
|
||||||
|
|
||||||
|
(in-package :scopes/app/demo)
|
||||||
|
|
||||||
|
(config:root :env-keys '(:docroot :address :port)
|
||||||
|
:env-path (util:runtime-path ".env"))
|
||||||
|
|
||||||
|
(config:add :server :class 'server:config
|
||||||
|
:port "8800"
|
||||||
|
:address "0.0.0.0"
|
||||||
|
:routes
|
||||||
|
`((("api") server:message-handler)
|
||||||
|
(() server:fileserver
|
||||||
|
:doc-root
|
||||||
|
,(make-pathname
|
||||||
|
:directory (list :absolute (config:from-env :docroot "/var/www"))))))
|
||||||
|
;,(util:home-path "" "hugo" "0-public" "scopes" "hx"))))
|
|
@ -2,7 +2,11 @@
|
||||||
|
|
||||||
(defpackage :scopes/app/demo
|
(defpackage :scopes/app/demo
|
||||||
(:use :common-lisp)
|
(:use :common-lisp)
|
||||||
(:local-nicknames (:forge :scopes/forge))
|
(:local-nicknames (:config :scopes/config)
|
||||||
|
(:core :scopes/core)
|
||||||
|
(:forge :scopes/forge)
|
||||||
|
(:server :scopes/web/server)
|
||||||
|
(:util :scopes/util))
|
||||||
(:export #:main))
|
(:export #:main))
|
||||||
|
|
||||||
(in-package :scopes/app/demo)
|
(in-package :scopes/app/demo)
|
||||||
|
@ -11,6 +15,9 @@
|
||||||
(format t "~%Hello World.~%relative path: ~a~%system source dir: ~a~%"
|
(format t "~%Hello World.~%relative path: ~a~%system source dir: ~a~%"
|
||||||
(asdf:system-relative-pathname :scopes-demo "config")
|
(asdf:system-relative-pathname :scopes-demo "config")
|
||||||
(asdf:system-source-directory :scopes-demo))
|
(asdf:system-source-directory :scopes-demo))
|
||||||
|
(load (util:relative-path "config" "etc"))
|
||||||
|
(core:setup-services)
|
||||||
(setf forge:*forge-env* (forge:forge-env))
|
(setf forge:*forge-env* (forge:forge-env))
|
||||||
(forge:setup-builtins)
|
(forge:setup-builtins)
|
||||||
(forge:repl))
|
(forge:repl)
|
||||||
|
(core:shutdown))
|
||||||
|
|
|
@ -48,11 +48,14 @@
|
||||||
(let* ((key (str:concat prefix (string sl)))
|
(let* ((key (str:concat prefix (string sl)))
|
||||||
(env-val (uiop:getenv key))
|
(env-val (uiop:getenv key))
|
||||||
(dotenv-val (if dotenv-data (gethash key dotenv-data))))
|
(dotenv-val (if dotenv-data (gethash key dotenv-data))))
|
||||||
|
(format t "~&init after config:root key: ~s, env-val ~s~%"
|
||||||
|
key dotenv-val)
|
||||||
(if env-val
|
(if env-val
|
||||||
(setf (gethash sl data) env-val)
|
(setf (gethash sl data) env-val)
|
||||||
(setf (gethash sl data) dotenv-val))))))
|
(setf (gethash sl data) dotenv-val))))))
|
||||||
|
|
||||||
(defun root (&rest params &key (class 'root) &allow-other-keys)
|
(defun root (&rest params &key (class 'root) &allow-other-keys)
|
||||||
|
(format t "~&config:root params: ~s~%" params)
|
||||||
(setf *root* (apply #'make-instance class params)))
|
(setf *root* (apply #'make-instance class params)))
|
||||||
|
|
||||||
;;;; config base class
|
;;;; config base class
|
||||||
|
|
|
@ -31,19 +31,23 @@
|
||||||
(clack:clackup #'(lambda (env) (app ctx env))
|
(clack:clackup #'(lambda (env) (app ctx env))
|
||||||
:port (parse-integer (port cfg))
|
:port (parse-integer (port cfg))
|
||||||
:address (address cfg)
|
:address (address cfg)
|
||||||
:server :woo
|
;:server :woo
|
||||||
:silent t))))
|
:silent t))))
|
||||||
|
|
||||||
(defun stop (ctx)
|
(defun stop (ctx)
|
||||||
(clack:stop (listener ctx)))
|
(clack:stop (listener ctx)))
|
||||||
|
|
||||||
(defun fileserver (ctx env &key doc-root)
|
(defun fileserver (ctx env &key doc-root)
|
||||||
(let* ((message-head (getf env :message-head))
|
(let ((message-head (getf env :message-head)))
|
||||||
(rel-path (str:join "/" message-head))
|
(if (string= (car (last message-head)) "")
|
||||||
|
(setf message-head (append (butlast message-head) (list "index.html"))))
|
||||||
|
(let* ((rel-path (str:join "/" message-head))
|
||||||
(file-app (make-instance 'lack/app/file:lack-app-file
|
(file-app (make-instance 'lack/app/file:lack-app-file
|
||||||
:file rel-path :root doc-root)))
|
:file rel-path :root doc-root)))
|
||||||
;(format t "~&file path: ~s~%" (merge-pathnames rel-path doc-root))
|
;(format t "~&file path: ~s~%" (merge-pathnames rel-path doc-root))
|
||||||
(lack/component:call file-app env)))
|
;(format t "~&file head: ~s, rel-path ~s~%" message-head rel-path)
|
||||||
|
(format t "~&file doc-root ~s~%" doc-root)
|
||||||
|
(lack/component:call file-app env))))
|
||||||
|
|
||||||
(defun message-handler (ctx env)
|
(defun message-handler (ctx env)
|
||||||
;(print env)
|
;(print env)
|
||||||
|
|
Loading…
Add table
Reference in a new issue