From 142166df54eda65925921799a4bb3e7f6cdaba48 Mon Sep 17 00:00:00 2001 From: ckonstanski Date: Tue, 6 Feb 2018 21:42:54 -0700 Subject: initial commit --- .../clojurescript/music-dispensary/.gitignore | 14 + .../clojurescript/music-dispensary/README.md | 14 + .../clojurescript/music-dispensary/project.clj | 13 + .../clojurescript/music-dispensary/src/core.cljs | 330 +++++++++++++++++++++ webapps/music-dispensary/conf/.gitignore | 1 + webapps/music-dispensary/conf/options.lisp.example | 6 + webapps/music-dispensary/site.lisp | 76 +++++ .../music-dispensary/static/images/edit-delete.png | Bin 0 -> 1121 bytes .../music-dispensary/static/images/file-icon.jpg | Bin 0 -> 17659 bytes .../music-dispensary/static/images/folder-icon.jpg | Bin 0 -> 18029 bytes webapps/music-dispensary/static/js/cljs | 1 + webapps/music-dispensary/static/lilypond | 1 + webapps/webapp-loader.lisp | 145 +++++++++ 13 files changed, 601 insertions(+) create mode 100644 webapps/music-dispensary/clojurescript/music-dispensary/.gitignore create mode 100644 webapps/music-dispensary/clojurescript/music-dispensary/README.md create mode 100644 webapps/music-dispensary/clojurescript/music-dispensary/project.clj create mode 100644 webapps/music-dispensary/clojurescript/music-dispensary/src/core.cljs create mode 100644 webapps/music-dispensary/conf/.gitignore create mode 100644 webapps/music-dispensary/conf/options.lisp.example create mode 100644 webapps/music-dispensary/site.lisp create mode 100644 webapps/music-dispensary/static/images/edit-delete.png create mode 100644 webapps/music-dispensary/static/images/file-icon.jpg create mode 100644 webapps/music-dispensary/static/images/folder-icon.jpg create mode 120000 webapps/music-dispensary/static/js/cljs create mode 120000 webapps/music-dispensary/static/lilypond create mode 100644 webapps/webapp-loader.lisp (limited to 'webapps') 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 Binary files /dev/null and b/webapps/music-dispensary/static/images/edit-delete.png differ 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 Binary files /dev/null and b/webapps/music-dispensary/static/images/file-icon.jpg differ 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 Binary files /dev/null and b/webapps/music-dispensary/static/images/folder-icon.jpg differ 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))))) -- cgit v1.3