diff options
| -rw-r--r-- | .gitignore | 2 | ||||
| -rw-r--r-- | config.lisp.example | 3 | ||||
| -rw-r--r-- | src/dnd.lisp | 11 | ||||
| -rw-r--r-- | src/endpoints.lisp | 4 | ||||
| -rw-r--r-- | src/flash.lisp | 3 | ||||
| -rw-r--r-- | src/init.lisp | 31 | ||||
| -rw-r--r-- | src/utilities.lisp | 4 |
7 files changed, 45 insertions, 13 deletions
@@ -1,2 +1,4 @@ *~ /bin/ +/config.lisp +/dnd-store/ diff --git a/config.lisp.example b/config.lisp.example new file mode 100644 index 0000000..c1be431 --- /dev/null +++ b/config.lisp.example @@ -0,0 +1,3 @@ +(:datastore-directory #P"/home/projects/dnd/dnd-store/" + :host "localhost" + :port 8888) diff --git a/src/dnd.lisp b/src/dnd.lisp index 952b8fe..70edd7d 100644 --- a/src/dnd.lisp +++ b/src/dnd.lisp @@ -2,16 +2,23 @@ (in-package #:dnd) +(defvar *config* nil + "Instance of the config class globally available.") + (defvar *dnd-arena* nil "The instance of the HTTP server") -(defun start () - (init-db) +(defun start (&optional config-path) + "Configures and initializes the datastore and web server, then starts the server." + (setf *config* (config-from-file (or config-path + (asdf:system-relative-pathname "dnd" "config.lisp")))) + (init-db *config*) (setf *dnd-arena* (lzb:create-server)) (lzb:install-app *dnd-arena* (lzb:app 'dnd)) (lzb:start-server *dnd-arena*)) (defun boot () + "Main entrypoint for an executable version of DND." (swank:create-server :port 9876 :dont-close t) (start) (loop (sleep 1))) diff --git a/src/endpoints.lisp b/src/endpoints.lisp index 62d70ee..acc62c9 100644 --- a/src/endpoints.lisp +++ b/src/endpoints.lisp @@ -116,11 +116,11 @@ functions in url parameters in endpoint definitions." (new-sesh player))) (lzb:set-response-cookie +session-cookie-name+ (session-id sesh) - :path "/" :domain "localhost") ; TODO: generalize domain + :path "/" :domain (host *config*)) (redirect-to "/tavern")) (progn (flash :tavern-door (format nil "Hrmm... ~a you say? It ain't on the register." nick)) - (redirect-to "/tavern-door")))) ) + (redirect-to "/tavern-door"))))) (defendpoint* :get "/join" () () (render (page-render-mode) :join)) diff --git a/src/flash.lisp b/src/flash.lisp index b655fa0..f737d86 100644 --- a/src/flash.lisp +++ b/src/flash.lisp @@ -43,8 +43,7 @@ expires." ;; set the cookie, updating its expiration if necessary (lzb:set-response-cookie +flash-cookie-name+ key - ;; TODO: generalize domain - :path "/" :domain "localhost" + :path "/" :domain (host *config*) :expires (+ +flash-value-lifetime+ now)))) diff --git a/src/init.lisp b/src/init.lisp index 68b2a16..d7636a6 100644 --- a/src/init.lisp +++ b/src/init.lisp @@ -2,11 +2,28 @@ (in-package #:dnd) -(defun init-db (&optional config) +;;; CONFIGURATION + +(defvar *config* nil) + +(defclass/std config () + ((datastore-directory :ir :std #P"/srv/dnd/store/") + (swank-port :std nil :doc "If set, swank is started on this port.") + (host :std "0.0.0.0") + (port :ir :std 8888))) + +(defun config-from-file (path) + "PATH should be a path to a file containing a PLIST suitable for + passing as the keyword arguments to (MAKE-INSTANCE 'CONFIG ...)" + (apply #'make-instance 'config (read-from-file path))) + +;;; DATASTORE + +(defun init-db (config) + "Initializes the data store with values from the CONFIG." + (ensure-directories-exist (datastore-directory config)) (unless (boundp 'db:*store*) - (unless config - nil ; TODO: handle the case where we have a config - (make-instance - 'db:mp-store - :directory (merge-pathnames "dnd-store/" (user-homedir-pathname)) - :subsystems (list (make-instance 'db:store-object-subsystem)))))) + (make-instance + 'db:mp-store + :directory (datastore-directory config) + :subsystems (list (make-instance 'db:store-object-subsystem))))) diff --git a/src/utilities.lisp b/src/utilities.lisp index 539ad28..3852399 100644 --- a/src/utilities.lisp +++ b/src/utilities.lisp @@ -70,3 +70,7 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (defun starts-with-vowel-p (string) (find (elt string 0) "aeiou" :test #'char-equal))) + +(defun read-from-file (path) + (read-from-string + (alexandria:read-file-into-string path))) |