provide config:path function for env-overridable paths (like log-path)

This commit is contained in:
Helmut Merz 2024-07-18 12:22:34 +02:00
parent 1ec80a559f
commit 3217a16002
4 changed files with 9 additions and 4 deletions

View file

@ -14,6 +14,6 @@
:routes :routes
`((("api") server:message-handler) `((("api") server:message-handler)
(() server:fileserver :doc-root (() server:fileserver :doc-root
,(util:absolute-dir (config:from-env :docroot "/var/www/html"))))) ;,(util:path-from-string (config:from-env :docroot "/var/www/html/")))))
;,(config:directory "/var/www/html" :env :docroot) ,(config:path "/var/www/html/" :env-key :docroot))))
(config:add-action '(:test :data) #'core:echo) (config:add-action '(:test :data) #'core:echo)

View file

@ -4,8 +4,9 @@
(defpackage :scopes/config (defpackage :scopes/config
(:use :common-lisp) (:use :common-lisp)
(:local-nicknames (:util :scopes/util))
(:export #:base #:root #:*root* #:*current* (:export #:base #:root #:*root* #:*current*
#:env-data #:env-keys #:env-prefix #:env-path #:from-env #:env-data #:env-keys #:env-prefix #:env-path #:from-env #:path
#:actions #:add #:add-action #:children #:env-slots #:actions #:add #:add-action #:children #:env-slots
#:name #:setup #:parent #:shutdown)) #:name #:setup #:parent #:shutdown))
@ -90,6 +91,9 @@
(defun from-env (key default) (defun from-env (key default)
(or (gethash key (env-data *root*)) default)) (or (gethash key (env-data *root*)) default))
(defun path (s &key env-key)
(util:path-from-string (from-env env-key s)))
(defun hash-to-slots (ht obj slots) (defun hash-to-slots (ht obj slots)
(if ht (if ht
(dolist (sl slots) (dolist (sl slots)

View file

@ -76,12 +76,13 @@
(tail (last message-head))) (tail (last message-head)))
(if (string= (car tail) "") (if (string= (car tail) "")
(setf (car tail) "index.html")) (setf (car tail) "index.html"))
(log:debug "doc-root: ~s" doc-root)
(let* ((rel-path (str:join "/" message-head)) (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)))
(lack/component:call file-app env)))) (lack/component:call file-app env))))
(defun message-handler (ctx env) (defun message-handler (ctx env &key html-renderer)
(let* ((iact (make-instance 'interaction)) (let* ((iact (make-instance 'interaction))
(msg (message:create (msg (message:create
(head env) :data (plist (post-data env)) :sender iact)) (head env) :data (plist (post-data env)) :sender iact))