13 files changed, 601 insertions, 0 deletions

diff --git a/webapps/music-dispensary/clojurescript/music-dispensary/.gitignore b/webapps/music-dispensary/clojurescript/music-dispensary/.gitignore
new file mode 100644
index 0000000..c754477
--- /dev/null
+++ b/webapps/music-dispensary/clojurescript/music-dispensary/.gitignore
@@ -0,0 +1,14 @@
+target
+classes
+resources
+checkouts
+pom.xml
+pom.xml.asc
+*.jar
+*.class
+.lein-*
+.nrepl-port
+.hgignore
+.hg
+profiles.clj
+figwheel_server.log
diff --git a/webapps/music-dispensary/clojurescript/music-dispensary/README.md b/webapps/music-dispensary/clojurescript/music-dispensary/README.md
new file mode 100644
index 0000000..2de33dd
--- /dev/null
+++ b/webapps/music-dispensary/clojurescript/music-dispensary/README.md
@@ -0,0 +1,14 @@
+# music-dispensary
+
+A Clojure library designed to ... well, that part is up to you.
+
+## Usage
+
+FIXME
+
+## License
+
+Copyright © 2017 FIXME
+
+Distributed under the Eclipse Public License either version 1.0 or (at
+your option) any later version.
diff --git a/webapps/music-dispensary/clojurescript/music-dispensary/project.clj b/webapps/music-dispensary/clojurescript/music-dispensary/project.clj
new file mode 100644
index 0000000..e904105
--- /dev/null
+++ b/webapps/music-dispensary/clojurescript/music-dispensary/project.clj
@@ -0,0 +1,13 @@
+(defproject music-dispensary "0.1.0-SNAPSHOT"
+  :description "An LDAP adminitration utility written in SBCL on the
+  server-side and ClojureScript on the client-side. This is the
+  client-side component."
+  :url "FIXME"
+  :license "public domain"
+  :dependencies [[org.clojure/clojure "LATEST"]
+                 [org.clojure/clojurescript "LATEST"]
+                 [cljs-ajax "LATEST"]
+                 [prismatic/dommy "LATEST"]
+                 [hiccups "LATEST"]]
+  :plugins [[lein-cljsbuild "LATEST"]]
+  :clean-targets ^{:protect false} [:target-path "out" "resources/public/cljs"])
diff --git a/webapps/music-dispensary/clojurescript/music-dispensary/src/core.cljs b/webapps/music-dispensary/clojurescript/music-dispensary/src/core.cljs
new file mode 100644
index 0000000..d640d1b
--- /dev/null
+++ b/webapps/music-dispensary/clojurescript/music-dispensary/src/core.cljs
@@ -0,0 +1,330 @@
+(ns music-dispensary.core
+  (:require-macros [hiccups.core :as hiccups :refer [html]])
+  (:require [ajax.core :refer [GET POST]]
+            [dommy.core :as dommy]
+            [hiccups.runtime :as hiccupsrt]))
+
+;; ========================================================================== ;;
+;; declarations
+
+(enable-console-print!)
+
+(declare template-message)
+(declare maybe-error)
+(declare maybe-message)
+(declare notifications)
+(declare auth-notifications)
+(declare template-generic-form)
+(declare template-menu)
+(declare handler-menu)
+(declare render-menu)
+(declare template-home)
+(declare handler-home)
+(declare render-home)
+(declare handler-login)
+(declare render-login)
+(declare handler-login-authenticate)
+(declare render-login-authenticate)
+(declare handler-logout)
+(declare render-logout)
+(declare template-browse)
+(declare handler-browse)
+(declare render-browse)
+(declare on-browse-browser-node-clicked)
+(declare template-browse-browser)
+(declare handler-browse-browser)
+(declare render-browse-browser)
+(declare on-browse-papersize-clicked)
+(declare template-browse-papersize)
+(declare handler-browse-papersize)
+(declare render-browse-papersize)
+(declare handler-browse-generate)
+(declare render-browse-generate)
+(declare on-menu-clicked)
+(declare handler-location)
+(declare goto-location)
+
+;; ========================================================================== ;;
+;; notifications
+
+(hiccups/defhtml template-error [errormsg]
+  [:div {:class "alert alert-danger"} errormsg])
+
+(hiccups/defhtml template-message [message]
+  [:div {:class "alert alert-success"} message])
+
+(defn maybe-error [jsonobj]
+  (cond (get jsonobj "errormsg")
+        (dommy/set-html! (dommy/sel1 :#errormsg)
+                         (template-error (get jsonobj "errormsg")))
+        :else
+        (dommy/set-html! (dommy/sel1 :#errormsg) "")))
+
+(defn maybe-message [jsonobj]
+  (cond (get jsonobj "message")
+        (dommy/set-html! (dommy/sel1 :#message)
+                         (template-message (get jsonobj "message")))
+        :else
+        (dommy/set-html! (dommy/sel1 :#message) "")))
+
+(defn notifications [jsonobj]
+  (maybe-error jsonobj)
+  (maybe-message jsonobj))
+
+(defn auth-notifications [jsonobj]
+  (when (get jsonobj "errormsg")
+    (render-home)
+    (render-menu)))
+
+;; ========================================================================== ;;
+;; forms
+
+(hiccups/defhtml template-generic-form
+  ([jsonobj]
+   (template-generic-form jsonobj "on_menu_clicked"))
+  ([jsonobj onclick]
+   [:form {:name (get jsonobj "name")
+           :id (get jsonobj "name")
+           :class "form-horizontal"
+           :method (get jsonobj "httpMethod")}
+    (for [form-field (get jsonobj "formFields")]
+      (cond (= (get form-field "fieldType") "button")
+            [:div {:class "col-sm-offset-2 col-sm-10"}
+             [:button {:name (get form-field "name")
+                       :id (get form-field "name")
+                       :type (get form-field "fieldType")
+                       :class "btn btn-primary"
+                       :data-dismiss "modal"
+                       :onclick (str (clojure.string/replace (namespace ::x) "-" "_") "." onclick "('" (get jsonobj "action") "')")}
+              (get form-field "label")]]
+            :else
+            [:div {:class "form-group"}
+             [:label {:for (get form-field "name")
+                      :class "control-label col-sm-2"}
+              (get form-field "label")]
+             [:div {:class "col-sm-10"}
+              [:input {:name (get form-field "name")
+                       :id (get form-field "name")
+                       :type (get form-field "fieldType")
+                       :class "form-control"}]]]))]))
+
+;; ========================================================================== ;;
+;; menu
+
+(hiccups/defhtml template-menu [menuitems]
+  [:div {:class "row"}
+   (for [menuitem menuitems]
+     [:div {:class "col-lg-3"}
+      [:a {:class "menuitem"
+           :id (get menuitem "id")
+           :onclick (str (clojure.string/replace (namespace ::x) "-" "_") ".on_menu_clicked('" (get menuitem "handler") "')")}
+       (get menuitem "label")]])])
+
+(defn handler-menu [response]
+  (let [jsonobj (js->clj (js/JSON.parse response))]
+    (dommy/set-html! (dommy/sel1 :#menu) (template-menu (get jsonobj "menuitems")))))
+
+(defn render-menu []
+  (GET "/menu" {:handler handler-menu}))
+
+;; ========================================================================== ;;
+;; home
+
+(hiccups/defhtml template-home [jsonobj]
+  [:p {:align "center"} (get jsonobj "content")])
+
+(defn handler-home [response]
+  (let [jsonobj (js->clj (js/JSON.parse response))]
+    (dommy/set-html! (dommy/sel1 :#body) (template-home jsonobj))))
+
+(defn render-home []
+  (GET "/home" {:handler handler-home}))
+
+;; ========================================================================== ;;
+;; login
+
+(defn handler-login [response]
+  (let [jsonobj (js->clj (js/JSON.parse response))]
+    (notifications jsonobj)
+    (dommy/set-html! (dommy/sel1 :#body) (template-generic-form jsonobj))))
+
+(defn render-login []
+  (GET "/login" {:handler handler-login}))
+
+;; ========================================================================== ;;
+;; login-authenticate
+
+(defn handler-login-authenticate [response]
+  (let [jsonobj (js->clj (js/JSON.parse response))]
+    (cond (get jsonobj "errormsg")
+          (render-login)
+          (get jsonobj "message")
+          (render-home))
+    (render-menu)
+    (notifications jsonobj)))
+
+(defn render-login-authenticate []
+  (POST "/login/authenticate" {:format :raw
+                               :params {:username (dommy/value (dommy/sel1 :#username))
+                                        :password (dommy/value (dommy/sel1 :#password))}
+                               :handler handler-login-authenticate}))
+
+;; ========================================================================== ;;
+;; logout
+
+(defn handler-logout [response]
+  (let [jsonobj (js->clj (js/JSON.parse response))]
+    (render-home)
+    (render-menu)
+    (notifications jsonobj)))
+
+(defn render-logout []
+  (GET "/logout" {:handler handler-logout}))
+
+;; ========================================================================== ;;
+;; browse
+
+(hiccups/defhtml template-browse [jsonobj]
+  [:p {:align "center"} (get jsonobj "instructions")]
+  [:div {:class "row"}
+   [:div {:class "col-lg-6"}
+    [:div {:id "browser"}]]
+   [:div {:class "col-lg-6"}
+    [:div {:id "papersize"}]]])
+
+(defn handler-browse [response]
+  (let [jsonobj (js->clj (js/JSON.parse response))]
+    (dommy/set-html! (dommy/sel1 :#body) (template-browse jsonobj))
+    (render-browse-browser)
+    (render-browse-papersize)))
+
+(defn render-browse []
+  (GET "/browse" {:handler handler-browse}))
+
+;; ========================================================================== ;;
+;; browse-browser
+
+(defn on-browse-browser-node-clicked [node]
+  (dommy/set-value! (dommy/sel1 :#node) node)
+  (cond (clojure.string/ends-with? node ".ly")
+        (do
+          (dommy/set-value! (dommy/sel1 :#file) node)
+          (dommy/set-style! (dommy/sel1 :#generate) :display "inline"))
+        (clojure.string/ends-with? node ".pdf")
+        (render-browse-generate node)
+        :else
+        (render-browse-browser)))
+
+(hiccups/defhtml template-browse-browser [jsonobj]
+  [:form {:name "browse-browser-form"
+          :id "browse-browser-form"}
+   [:input {:type "hidden"
+            :name "relative-path"
+            :id "relative-path"
+            :value (get jsonobj "relativePath")}]
+   [:input {:type "hidden"
+            :name "node"
+            :id "node"
+            :value ""}]]
+  (for [node (get jsonobj "nodes")]
+    [:p
+     [:img {:src (str "static/images/" (cond (= (get node "nodeType") "directory") "folder-icon.jpg" :else "file-icon.jpg"))}]
+     "    "
+     [:a {:style "cursor:pointer; cursor:hand;"
+          :onclick (str (clojure.string/replace (namespace ::x) "-" "_") ".on_browse_browser_node_clicked('" (get node "path") "')")}
+      (cond (= (get node "path") "..") [:i "Up one level"] :else (get node "path"))]]))
+
+(defn handler-browse-browser [response]
+  (let [jsonobj (js->clj (js/JSON.parse response))]
+    (dommy/set-html! (dommy/sel1 :#browser) (template-browse-browser jsonobj))))
+
+(defn render-browse-browser []
+  (POST "/browse/browser" {:format :raw
+                           :params {:relative-path (cond (dommy/sel1 :#relative-path) (dommy/value (dommy/sel1 :#relative-path)) :else "")
+                                    :node (cond (dommy/sel1 :#node) (dommy/value (dommy/sel1 :#node)) :else "")}
+                           :handler handler-browse-browser}))
+
+;; ========================================================================== ;;
+;; browse-papersize
+
+(defn on-browse-papersize-clicked []
+  (let [jquery (js* "$")]
+    (dommy/set-style! (dommy/sel1 :#generate) :display "none")
+    (render-browse-generate (dommy/value (dommy/sel1 :#file)) (.val (jquery "#papersize :selected")))))
+  
+(hiccups/defhtml template-browse-papersize [jsonobj]
+  [:form {:name "browse-papersize-form"
+          :id "browse-papersize-form"
+          :class "form-horizontal"}
+   [:div {:class "form-group"}
+    [:label {:for "papersize"
+             :class "control-label"}
+     "The file you selected"]
+    [:input {:type "text"
+             :name "file"
+             :id "file"
+             :value ""
+             :class "form-control"
+             :readonly "readonly"}]]
+   [:div {:class "form-group"}
+    [:label {:for "papersize"
+             :class "control-label"}
+     "Select a paper size"]
+    [:select {:name "papersize"
+              :id "papersize"
+              :class "form-control"}
+     (for [papersize (get jsonobj "papersizes")]
+       [:option {:value (get papersize "name")} (str (get papersize "name") " " (get papersize "size"))])]]
+   [:div {:class "form-group"}
+    [:button {:type "button"
+              :name "generate"
+              :id "generate"
+              :data-dismiss "modal"
+              :style "display:none;"
+              :onclick (str (clojure.string/replace (namespace ::x) "-" "_") ".on_browse_papersize_clicked()")}
+     "Generate PDF"]]])
+
+(defn handler-browse-papersize [response]
+  (let [jsonobj (js->clj (js/JSON.parse response))]
+    (dommy/set-html! (dommy/sel1 :#papersize) (template-browse-papersize jsonobj))))
+
+(defn render-browse-papersize []
+  (GET "/browse/papersize" {:handler handler-browse-papersize}))
+
+;; ========================================================================== ;;
+;; browse-generate
+
+(defn handler-browse-generate [response]
+  (let [jsonobj (js->clj (js/JSON.parse response))]
+    (.open js/window (get jsonobj "url"))))
+
+(defn render-browse-generate
+  ([node]
+   (POST "/browse/generate" {:format :raw
+                             :params {:file node :papersize ""}
+                             :handler handler-browse-generate}))
+  ([node papersize]
+   (POST "/browse/generate" {:format :raw
+                             :params {:file node :papersize papersize}
+                             :handler handler-browse-generate})))
+
+;; ========================================================================== ;;
+;; location
+
+(defn on-menu-clicked [handler]
+   (cond (= handler "/home") (render-home)
+         (= handler "/login") (render-login)
+         (= handler "/login/authenticate") (render-login-authenticate)
+         (= handler "/logout") (render-logout)
+         (= handler "/browse") (render-browse)))
+
+(defn handler-location [response]
+  (let [jsonobj (js->clj (js/JSON.parse response))]
+    (on-menu-clicked (get jsonobj "location"))
+    (render-menu)
+    (notifications jsonobj)))
+
+(defn goto-location []
+  (GET "/location" {:handler handler-location}))
+
+(set! (.-onload js/window) goto-location)
diff --git a/webapps/music-dispensary/conf/.gitignore b/webapps/music-dispensary/conf/.gitignore
new file mode 100644
index 0000000..14fa7a6
--- /dev/null
+++ b/webapps/music-dispensary/conf/.gitignore
@@ -0,0 +1 @@
+options.lisp
diff --git a/webapps/music-dispensary/conf/options.lisp.example b/webapps/music-dispensary/conf/options.lisp.example
new file mode 100644
index 0000000..dc3678c
--- /dev/null
+++ b/webapps/music-dispensary/conf/options.lisp.example
@@ -0,0 +1,6 @@
+((:name "music-dispensary"
+  :url "music-dispensary.tld"
+  :document-root "music-dispensary"
+  :title "music-dispensary"
+  :meta-description "music-dispensary"
+  :mime-extensions ("ly" "pdf")))
diff --git a/webapps/music-dispensary/site.lisp b/webapps/music-dispensary/site.lisp
new file mode 100644
index 0000000..f74236c
--- /dev/null
+++ b/webapps/music-dispensary/site.lisp
@@ -0,0 +1,76 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package #:music-dispensary)
+
+;; ========================================================================== ;;
+
+(defmacro .base ()
+  `(html5
+    `(html
+      (head
+       ((meta :name "viewport" :content "width=device-width, initial-scale=1"))
+       ((meta :charset "utf-8"))
+       ((title) ,(title *webapp*))
+       ,@(mapcar (lambda (css)
+                   `((link :rel "stylesheet" :href ,css)))
+                 '("https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css")))
+       ,@(mapcar (lambda (js)
+                   `((script :type "text/javascript" :src ,js)))
+                 '("https://ajax.googleapis.com/ajax/libs/jquery/3.2.0/jquery.min.js"
+                   "https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/js/bootstrap.min.js"
+                   "/static/js/cljs/main.js"))
+      (body
+       ((div :class "container-fluid")
+        ((div :class "page-header")
+         ((h2 :align "center") ,(title *webapp*)))
+        ((div :id "menu" :class "well"))
+        ((div :id "errormsg"))
+        ((div :id "message"))
+        ((div :id "body")))))))
+
+;; ========================================================================== ;;
+
+(defmacro .location ()
+  `(location-json))
+
+(defmacro .home ()
+  `(home-json))
+
+(defmacro .menu ()
+  `(menu-json))
+
+(defmacro .login ()
+  `(login-json))
+
+(defmacro .login-authenticate ()
+  `(login-authenticate-json username password))
+
+(defmacro .logout ()
+  `(logout-json))
+
+(defmacro .browse ()
+  `(browse-json))
+
+(defmacro .browse-browser ()
+  `(browse-browser-json relative-path node))
+
+(defmacro .browse-papersize ()
+  `(browse-papersize-json))
+
+(defmacro .browse-generate ()
+  `(browse-generate-json file papersize))
+
+;; ========================================================================== ;;
+
+(define-endpoint :get "/" () .base)
+(define-endpoint :get "/location" () .location)
+(define-endpoint :get "/home" () .home)
+(define-endpoint :get "/menu" () .menu)
+(define-endpoint :get "/login" () .login)
+(define-endpoint :post "/login/authenticate" ((username :parameter-type 'string) (password :parameter-type 'string)) .login-authenticate)
+(define-endpoint :get "/logout" () .logout)
+(define-endpoint :get "/browse" () .browse)
+(define-endpoint :post "/browse/browser" ((relative-path :parameter-type 'string) (node :parameter-type 'string)) .browse-browser)
+(define-endpoint :get "/browse/papersize" () .browse-papersize)
+(define-endpoint :post "/browse/generate" ((file :parameter-type 'string) (papersize :parameter-type 'string)) .browse-generate)
diff --git a/webapps/music-dispensary/static/images/edit-delete.png b/webapps/music-dispensary/static/images/edit-delete.png
new file mode 100644
index 0000000..b0de61d
--- /dev/null
+++ b/webapps/music-dispensary/static/images/edit-delete.png
diff --git a/webapps/music-dispensary/static/images/file-icon.jpg b/webapps/music-dispensary/static/images/file-icon.jpg
new file mode 100644
index 0000000..c6a2d9a
--- /dev/null
+++ b/webapps/music-dispensary/static/images/file-icon.jpg
diff --git a/webapps/music-dispensary/static/images/folder-icon.jpg b/webapps/music-dispensary/static/images/folder-icon.jpg
new file mode 100644
index 0000000..ed417be
--- /dev/null
+++ b/webapps/music-dispensary/static/images/folder-icon.jpg
diff --git a/webapps/music-dispensary/static/js/cljs b/webapps/music-dispensary/static/js/cljs
new file mode 120000
index 0000000..55fd981
--- /dev/null
+++ b/webapps/music-dispensary/static/js/cljs
@@ -0,0 +1 @@
+../../clojurescript/music-dispensary/resources/public/cljs
\ No newline at end of file
diff --git a/webapps/music-dispensary/static/lilypond b/webapps/music-dispensary/static/lilypond
new file mode 120000
index 0000000..34af233
--- /dev/null
+++ b/webapps/music-dispensary/static/lilypond
@@ -0,0 +1 @@
+/home/ckonstanski/Musik/lilypond
\ No newline at end of file
diff --git a/webapps/webapp-loader.lisp b/webapps/webapp-loader.lisp
new file mode 100644
index 0000000..679344e
--- /dev/null
+++ b/webapps/webapp-loader.lisp
@@ -0,0 +1,145 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package #:music-dispensary)
+
+(defvar *acceptor* nil)
+(defvar *dispatch-table* '(#'dispatch-easy-handlers #'default-dispatcher))
+(defvar *webapps* (make-hash-table :test 'equal))
+(defvar *webapp* nil)
+(defparameter *port* 3007)
+(defparameter *session-timeout* 14400)
+
+(defclass webapp ()
+  ((name :initarg :name
+         :initform nil
+         :accessor name
+         :documentation "The name of the webapp as used in the code. A
+string used as the key to any webapp config lookup.")
+   (url :initarg :url
+        :initform nil
+        :accessor url
+        :documentation "The domain portion of the URL to the
+root of the webapp.")
+   (document-root :initarg :document-root
+                  :initform nil
+                  :accessor document-root
+                  :documentation "The absolute filesystem path to
+the webapp's top-level directory, which is inside the webapps
+folder.")
+   (title :initarg :title
+          :initform nil
+          :accessor title
+          :documentation "The default title that shows up in
+the browser title bar.")
+   (meta-description :initarg :meta-description
+          :initform nil
+          :accessor meta-description
+          :documentation "The text that goes into the META DESCRIPTION
+tag, and anywhere else we want to put this text so that it will show
+up in Google.")
+   (mime-extensions :initarg :mime-extensions
+                    :initform nil
+                    :accessor mime-extensions))
+  (:documentation ""))
+
+(defgeneric get-site-file-path (webapp)
+  (:documentation "Builds a full filesystem path to a webapp's site
+file."))
+
+(defmethod get-site-file-path ((webapp webapp))
+  (format nil "~a/site" (document-root webapp)))
+
+(defgeneric get-pages-file-paths (webapp)
+  (:documentation ""))
+
+(defmethod get-pages-file-paths ((webapp webapp))
+  (mapcar (lambda (pages-file)
+            (ppcre:regex-replace-all "\\.lisp$" (format nil "~a" pages-file) ""))
+          (remove-if (lambda (x) (equal x "shared"))
+                     (shell-wrapper (format nil "find '~a' -maxdepth 1 -type f -iname 'pages*.lisp' |sort" (document-root webapp))))))
+
+(defun make-webapp-path (relative-path)
+  "Makes an absolute filesystem path to a location in the webapps
+folder."
+  (concatenate 'string *server-root* "webapps/" relative-path))
+
+(defun get-options-files ()
+  (mapcar (lambda (webapp-directory)
+            (format nil "~a/conf/options.lisp" webapp-directory))
+          (remove-if (lambda (x) (or (match-it "webapps/$" x)
+                                     (match-it "webapps/shared$" x)
+                                     (match-it "webapps/CVS$" x)
+                                     (match-it "webapps/\\.$" x)
+                                     (match-it "webapps/\\.\\.$" x)))
+                     (shell-wrapper (format nil "find '~a' -maxdepth 1 -type d |sort" (make-webapp-path ""))))))
+
+(defun set-webapp (webapp)
+  "Sets a `webapp' object in `*webapps*'.  The lookup key is the
+webapp name.  If a webapp already exists under this key, it gets
+overwritten with the new one."
+  (setf (gethash (name webapp) *webapps*) webapp))
+
+(defun get-webapp (key)
+  "Gets the webapp object."
+  (gethash key *webapps*))
+
+(defun generate-sessionid ()
+  "Generates a unique random string to seed the
+`*session-secret*'. The string is a SHA256 hash."
+  (let ((entropic-value (make-array '(32) :element-type '(unsigned-byte 8))))
+    (with-open-file (urandom-file "/dev/urandom" :direction :input :element-type '(unsigned-byte 8))
+      (loop for i from 0 to 31 do
+           (setf (elt entropic-value i) (read-byte urandom-file))))
+    (let ((digest (ironclad:make-digest 'ironclad:sha256)))
+      (ironclad:update-digest digest entropic-value)
+      (ironclad:byte-array-to-hex-string (ironclad:produce-digest digest)))))
+
+(defun populate-webapps ()
+  (loop for options-file in (get-options-files) do
+       (with-open-file (input options-file :direction :input)
+         (let* ((form (car (read input))))
+           (set-webapp (make-instance 'webapp
+                                      :name (getf form :name)
+                                      :url (getf form :url)
+                                      :document-root (make-webapp-path (getf form :document-root))
+                                      :title (getf form :title)
+                                      :meta-description (getf form :meta-description)
+                                      :mime-extensions (getf form :mime-extensions)))))))
+
+(defun music-dispensary ()
+  "Call this to start the server."
+  (when (null *acceptor*)
+    (let ((package (string-downcase (package-name *package*))))
+      (populate-webapps)
+      (setf (log-manager) (make-instance 'log-manager :message-class 'formatted-message))
+      (start-messenger 'text-file-messenger :filename (format nil "/var/log/lisp/~a.log" package))
+      (setf *session-secret* (generate-sessionid))
+      (populate-webapps)
+      (setf *acceptor* (start (make-instance 'easy-acceptor
+                                             :port *port*
+                                             :document-root (make-server-path (format nil "webapps/~a/" package))
+                                             :name (format nil "~a-acceptor" package)))))))
+
+(defmacro with-request-wrapper (uri page-function)
+  ;; Assigning package outside the backquote is necessary because
+  ;; *package* resolves incorrectly to common-lisp-user inside the
+  ;; backquote.
+  (let ((package (string-downcase (package-name *package*))))
+    `(let ((*webapp* (get-webapp ,package)))
+       (logger (format nil "Page request URI: [~a]" ,uri))
+       (unless *session*
+         (start-session)
+         (setf (session-max-time *session*) *session-timeout*)
+         (setf (session-value :permissions) "anonymous"))
+       (,page-function))))
+  
+(defmacro define-endpoint (request-type uri var-list page-function)
+  "Does the grunt work of creating an `easy-handler' for each page you
+wish to publish."
+  (let ((name (gensym)))
+    `(progn
+       (logger (format nil "Publishing page. URL = [~a]" ,uri))
+       (define-easy-handler (,name :uri ,uri :default-request-type ,request-type)
+           ,var-list
+         (with-request-wrapper ,uri ,page-function)))))