provide logging package = config for log4cl; set up app/demo accordingly

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)

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~%"
+  (let ((config-path (util:relative-path "config" "etc")))
-          (asdf:system-relative-pathname :scopes-demo "config")
+    (format t "~%Hello World.~%config-path: ~s~%" config-path)
-          (asdf:system-source-directory :scopes-demo))
+    (load config-path))
-  (load (util:relative-path "config" "etc"))
   (core:setup-services)
   (setf forge:*forge-env* (forge:forge-env))
   (forge:setup-builtins)

core/core.lisp

@@ -76,9 +76,10 @@
 (defun add-service (ctx cfg)
   (with-slots (services) ctx
     (let ((child (funcall (config:setup cfg) cfg)))
+      (when child
         (dolist (a (config:actions cfg))
           (add-action child (car a) (cadr a)))
-      (setf (gethash (config:name cfg) services) child))))
+        (setf (gethash (config:name cfg) services) child)))))
 
 (defgeneric send (rcvr msg)
   (:method ((rcvr context) msg)

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)))

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."

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)))

web/server.lisp

@@ -38,15 +38,15 @@
   (clack:stop (listener ctx)))
 
 (defun fileserver (ctx env &key doc-root)
-  (let ((message-head (getf env :message-head)))
+  (let* ((message-head (getf env :message-head))
-    (if (string= (car (last message-head)) "")
+         (tail (last message-head)))
-      (setf message-head (append (butlast message-head) (list "index.html"))))
+    (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)
-    (format t "~&file doc-root ~s~%" doc-root)
       (lack/component:call file-app env))))
 
 (defun message-handler (ctx 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)))