diff --git a/app/demo/etc/config.lisp b/app/demo/etc/config.lisp index e55b59d..8fe5174 100644 --- a/app/demo/etc/config.lisp +++ b/app/demo/etc/config.lisp @@ -2,9 +2,11 @@ (in-package :scopes/app/demo) -(config:root :env-keys '(:docroot :address :port) +(config:root :env-keys '(:docroot :address :port :loglevel :logfile) :env-path (util:runtime-path ".env")) +(config:add :logger :class 'logging:config) + (config:add :server :class 'server:config :port "8800" @@ -13,3 +15,4 @@ `((("api") server:message-handler) (() server:fileserver :doc-root ,(util:absolute-dir (config:from-env :docroot "/var/www/html"))))) + ;,(config:directory "/var/www/html" :env :docroot) diff --git a/app/demo/main.lisp b/app/demo/main.lisp index 4be358d..54199f5 100644 --- a/app/demo/main.lisp +++ b/app/demo/main.lisp @@ -5,6 +5,7 @@ (:local-nicknames (:config :scopes/config) (:core :scopes/core) (:forge :scopes/forge) + (:logging :scopes/logging) (:server :scopes/web/server) (:util :scopes/util)) (:export #:main)) @@ -12,10 +13,9 @@ (in-package :scopes/app/demo) (defun main() - (format t "~%Hello World.~%relative path: ~a~%system source dir: ~a~%" - (asdf:system-relative-pathname :scopes-demo "config") - (asdf:system-source-directory :scopes-demo)) - (load (util:relative-path "config" "etc")) + (let ((config-path (util:relative-path "config" "etc"))) + (format t "~%Hello World.~%config-path: ~s~%" config-path) + (load config-path)) (core:setup-services) (setf forge:*forge-env* (forge:forge-env)) (forge:setup-builtins) diff --git a/core/core.lisp b/core/core.lisp index 0feadff..492c244 100644 --- a/core/core.lisp +++ b/core/core.lisp @@ -76,9 +76,10 @@ (defun add-service (ctx cfg) (with-slots (services) ctx (let ((child (funcall (config:setup cfg) cfg))) - (dolist (a (config:actions cfg)) - (add-action child (car a) (cadr a))) - (setf (gethash (config:name cfg) services) child)))) + (when child + (dolist (a (config:actions cfg)) + (add-action child (car a) (cadr a))) + (setf (gethash (config:name cfg) services) child))))) (defgeneric send (rcvr msg) (:method ((rcvr context) msg) diff --git a/logging.lisp b/logging.lisp new file mode 100644 index 0000000..47204ae --- /dev/null +++ b/logging.lisp @@ -0,0 +1,30 @@ +;;;; cl-scopes/logging - mostly configuration for log4cl + +(defpackage :scopes/logging + (:use :common-lisp) + (:local-nicknames (:config :scopes/config) + (:util :scopes/util)) + (:export #:config #:setup)) + +(in-package :scopes/logging) + +(defclass config (config:base) + ((config:setup :initform #'setup) + (loglevel :reader loglevel :initarg :loglevel :initform :warn) + (logfile :reader logfile :initarg :logfile :initform "scopes.log") + (console :reader console :initarg :console :initform t))) + +(defun setup(cfg) + (let ((loglevel (config:from-env :loglevel (loglevel cfg))) + (logfile (config:from-env :logfile (logfile cfg))) + params) + (if (stringp loglevel) + (setf loglevel (util:to-keyword loglevel))) + (if (stringp logfile) + (setf logfile (util:path-from-string logfile))) + (util:ensure-dir logfile) + (format t "~&loglevel: ~s, logfile: ~s~%" loglevel logfile) + (setf params (list :sane loglevel :daily logfile)) + (if (console cfg) + (setf params (cons :console params))) + (apply #'log4cl:log-config params))) diff --git a/scopes-core.asd b/scopes-core.asd index d286756..61b45ba 100644 --- a/scopes-core.asd +++ b/scopes-core.asd @@ -11,9 +11,10 @@ :components ((:file "config" :depends-on ("util")) (:file "core/core" :depends-on ("core/message" "config" - "forge/forge" "util")) + "forge/forge" "logging" "util")) (:file "core/message") (:file "forge/forge") + (:file "logging" :depends-on ("config" "util")) (:file "util") (:file "testing" :depends-on ("util"))) :long-description "scopes/core: The core packages of the scopes project." diff --git a/util.lisp b/util.lisp index 67baf31..3a3536d 100644 --- a/util.lisp +++ b/util.lisp @@ -2,10 +2,17 @@ (defpackage :scopes/util (:use :common-lisp) - (:export #:absolute-dir #:home-path #:relative-path #:runtime-path #:system-path)) + (:export #:to-keyword + #:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string + #:relative-path #:runtime-path #:system-path)) (in-package :scopes/util) +;;;; symbols, keywords, ... + +(defun to-keyword(s) + (intern (string-upcase s) :keyword)) + ;;;; directory and pathname utilities (defun split-filename (name) @@ -32,3 +39,12 @@ (defun system-path (sys name &rest dirs) (asdf:system-relative-pathname sys (apply #'relative-path name dirs))) + +(defun path-from-string (s) + (uiop:parse-native-namestring (uiop:native-namestring s))) + +(defun check-dir (p) + (probe-file (directory-namestring p))) + +(defun ensure-dir (p) + (ensure-directories-exist (directory-namestring p))) diff --git a/web/server.lisp b/web/server.lisp index 0723213..38e26e8 100644 --- a/web/server.lisp +++ b/web/server.lisp @@ -38,16 +38,16 @@ (clack:stop (listener ctx))) (defun fileserver (ctx env &key doc-root) - (let ((message-head (getf env :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 rel-path :root doc-root))) - ;(format t "~&file path: ~s~%" (merge-pathnames rel-path doc-root)) - ;(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)))) + (let* ((message-head (getf env :message-head)) + (tail (last message-head))) + (if (string= (car tail) "") + (setf (car tail) "index.html")) + (let* ((rel-path (str:join "/" message-head)) + (file-app (make-instance 'lack/app/file:lack-app-file + :file rel-path :root doc-root))) + ;(format t "~&file path: ~s~%" (merge-pathnames rel-path doc-root)) + ;(format t "~&file head: ~s, rel-path ~s~%" message-head rel-path) + (lack/component:call file-app env)))) (defun message-handler (ctx env) ;(print env) @@ -92,9 +92,10 @@ (mapcar #'(lambda (e) (as-keyword e)) (getf env :message-head))) (defun post-data (env) + (if (getf env :content-length) (let* ((raw (getf env :raw-body)) (str (read-line (flexi-streams:make-flexi-stream raw)))) - (quri.decode:url-decode-params str))) + (quri.decode:url-decode-params str)))) (defun plist (alst) (let ((a2 (mapcar #'(lambda (p) (cons (as-keyword (car p)) (cdr p))) alst)))