diff options
Diffstat (limited to 'webapps')
| -rw-r--r-- | webapps/ldapadmin/clojurescript/ldapadmin/.gitignore | 1 | ||||
| -rw-r--r-- | webapps/ldapadmin/clojurescript/ldapadmin/src/core.cljs | 282 | ||||
| -rw-r--r-- | webapps/ldapadmin/site.lisp | 45 | ||||
| -rw-r--r-- | webapps/webapp-loader.lisp | 18 |
4 files changed, 217 insertions, 129 deletions
diff --git a/webapps/ldapadmin/clojurescript/ldapadmin/.gitignore b/webapps/ldapadmin/clojurescript/ldapadmin/.gitignore index c754477..a1cd79c 100644 --- a/webapps/ldapadmin/clojurescript/ldapadmin/.gitignore +++ b/webapps/ldapadmin/clojurescript/ldapadmin/.gitignore @@ -12,3 +12,4 @@ pom.xml.asc .hg profiles.clj figwheel_server.log +.rebel_readline_history diff --git a/webapps/ldapadmin/clojurescript/ldapadmin/src/core.cljs b/webapps/ldapadmin/clojurescript/ldapadmin/src/core.cljs index 268da39..e7ef977 100644 --- a/webapps/ldapadmin/clojurescript/ldapadmin/src/core.cljs +++ b/webapps/ldapadmin/clojurescript/ldapadmin/src/core.cljs @@ -4,7 +4,6 @@ [dommy.core :as dommy] [hiccups.runtime :as hiccupsrt])) -;; ========================================================================== ;; ;; declarations (enable-console-print!) @@ -21,8 +20,10 @@ (declare template-home) (declare handler-home) (declare render-home) +(declare template-login) (declare handler-login) (declare render-login) +(declare on-login-submit-clicked) (declare handler-login-authenticate) (declare render-login-authenticate) (declare handler-logout) @@ -31,15 +32,17 @@ (declare handler-inetorg-view) (declare render-inetorg-view) (declare on-inetorg-view-search-clicked) +(declare template-inetorg-view-search) (declare handler-inetorg-view-search) (declare render-inetorg-view-search) -(declare on-inetorg-modify-clicked) (declare template-inetorg-view-results) (declare handler-inetorg-view-results) (declare render-inetorg-view-results) +(declare on-inetorg-modify-clicked) +(declare template-inetorg-modify) (declare handler-inetorg-modify) (declare render-inetorg-modify) -(declare template-inetorg-modify-submit) +(declare on-inetorg-modify-submit-clicked) (declare handler-inetorg-modify-submit) (declare render-inetorg-modify-submit) (declare on-inetorg-delete-clicked) @@ -47,20 +50,20 @@ (declare handler-inetorg-delete) (declare render-inetorg-delete) (declare on-inetorg-delete-submit-clicked) -(declare template-inetorg-delete-submit) (declare handler-inetorg-delete-submit) (declare render-inetorg-delete-submit) +(declare template-inetorg-add) (declare handler-inetorg-add) (declare render-inetorg-add) (declare on-inetorg-add-submit-clicked) (declare handler-inetorg-add-submit) (declare render-inetorg-add-submit) -(declare template-location) (declare on-menu-clicked) (declare handler-location) (declare goto-location) -;; ========================================================================== ;; +(def jquery (js* "$")) + ;; notifications (hiccups/defhtml template-error [errormsg] @@ -70,68 +73,145 @@ [: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) ""))) + (let [errormsg (get jsonobj "errormsg")] + (cond (or (= nil errormsg) (= "" errormsg)) + (dommy/set-style! (dommy/sel1 :#errormsg) :display "none") + :else + (do + (dommy/set-style! (dommy/sel1 :#errormsg) :display "block") + (dommy/set-html! (dommy/sel1 :#errormsg) + (template-error 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) ""))) + (let [message (get jsonobj "message")] + (cond (or (= nil message) (= "" message)) + (dommy/set-style! (dommy/sel1 :#message) :display "none") + :else + (do + (dommy/set-style! (dommy/sel1 :#message) :display "block") + (dommy/set-html! (dommy/sel1 :#message) + (template-message message)))))) (defn notifications [jsonobj] (maybe-error jsonobj) (maybe-message jsonobj)) (defn auth-notifications [jsonobj] - (when (get jsonobj "errormsg") - (render-home) - (render-menu))) + (cond (get jsonobj "errormsg") + (do + (render-home "" (get jsonobj "errormsg")) + (render-menu)) + :else + (maybe-message jsonobj))) -;; ========================================================================== ;; ;; forms (hiccups/defhtml template-generic-form - ([jsonobj] - (template-generic-form jsonobj "on_menu_clicked")) - ([jsonobj onclick] + [:div {:id "form-errormsg"}] [:form {:name (get jsonobj "name") :id (get jsonobj "name") - :class "form-horizontal" - :method (get jsonobj "httpMethod")} + :method (get jsonobj "httpMethod") + :action (when (get jsonobj "action") + (str "javascript:" (namespace ::x) "." (get jsonobj "action")))} (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") + [:div {:class "form-group row"} + [:div {:class "offset-sm-2 col-sm-10"} + [:button {:class "btn btn-primary" + :data-dismiss (get jsonobj "dismiss") + :type (cond (get form-field "onclick") "button" :else "submit") + :onclick (when (get form-field "onclick") + (str (namespace ::x) "." (get form-field "onclick")))} + (get form-field "label")]]] + (= (get form-field "fieldType") "hidden") + [:input {:name (get form-field "name") + :id (get form-field "name") + :value (get form-field "value") + :type (get form-field "fieldType")}] + (= (get form-field "fieldType") "checkbox") + [:div {:class "form-check"} + [:input {:type "checkbox" + :class "form-check-input" + :id (get form-field "name") + :value (get form-field "value") + :checked (get form-field "checked") + :required (get form-field "required")}] + (when (get form-field "label") + [:label {:class "form-check-label" + :for (get form-field "name")} + (get form-field "label")])] + (= (get form-field "fieldType") "select") + [:div {:class "form-group"} + [:label {:for (get form-field "name")} + (get form-field "label")] + [:select {:class "form-control" + :name (get form-field "name") + :id (get form-field "name") + :required (get form-field "required") + :onchange (when (get form-field "onchange") + (str (namespace ::x) "." (get form-field "onchange")))} + (for [option (get form-field "options")] + [:option {:value (get option "value") + :selected (when (= (get option "value") (get form-field "value")) + "selected")} + (get option "label")])]] + (= (get form-field "fieldType") "textarea") + [:div {:class "form-group row"} + (when (get form-field "label") + [:label {:for (get form-field "name") + :class "col-form-label col-sm-2" + :style "text-align: right"} + (get form-field "label")]) + [:div {:class "col-sm-10"} + [:textarea {:name (get form-field "name") + :id (get form-field "name") + :rows "10" + :cols "68"} + (get form-field "value")]]] + (= (get form-field "fieldType") "datetime-local") + [:div {:class "form-group row"} + (when (get form-field "label") + [:label {:for (get form-field "name") + :class "col-form-label col-sm-2" + :style "text-align: right"} + (get form-field "label")]) + [:div {:class "col-sm-10"} + [:input {:name (get form-field "name") :id (get form-field "name") + :value (get form-field "value") :type (get form-field "fieldType") - :class "btn btn-primary" - :data-dismiss "modal" - :onclick (str (namespace ::x) "." onclick "('" (get jsonobj "action") "')")} - (get form-field "label")]] + :class "form-control" + :required (get form-field "required") + :min "2018-01-01T00:00" + :max "2020:12-31T23:59"}]]] :else - [:div {:class "form-group"} - [:label {:for (get form-field "name") - :class "control-label col-sm-2"} - (get form-field "label")] + [:div {:class "form-group row"} + (when (get form-field "label") + [:label {:for (get form-field "name") + :class "col-form-label col-sm-2" + :style "text-align: right"} + (get form-field "label")]) [:div {:class "col-sm-10"} [:input {:name (get form-field "name") :id (get form-field "name") + :value (get form-field "value") :type (get form-field "fieldType") - :class "form-control"}]]]))])) + :class "form-control" + :required (get form-field "required")}]]]))] + (when (get jsonobj "requiredP") + [:div "* Required"])) -;; ========================================================================== ;; ;; menu (hiccups/defhtml template-menu [menuitems] - [:div {:class "row"} + [:ul {:class "nav nav-pills"} (for [menuitem menuitems] - [:div {:class "col-lg-3"} - [:a {:class "menuitem" + [:li {:class "nav-item"} + [:a {:class (cond (= (clojure.string/upper-case (get menuitem "handler")) + (clojure.string/upper-case (dommy/html (dommy/sel1 :#location)))) + "nav-link active" + :else + "nav-link") :id (get menuitem "id") :onclick (str (namespace ::x) ".on_menu_clicked('" (get menuitem "handler") "')")} (get menuitem "label")]])]) @@ -143,70 +223,86 @@ (defn render-menu [] (GET "/menu" {:handler handler-menu})) -;; ========================================================================== ;; ;; home (hiccups/defhtml template-home [jsonobj] - [:h3 {:align "center"} (get jsonobj "content")]) + [:h3 {:style "text-align: center"} (get jsonobj "content")]) (defn handler-home [response] (let [jsonobj (js->clj (js/JSON.parse response))] + (notifications jsonobj) (dommy/set-html! (dommy/sel1 :#body) (template-home jsonobj)))) (defn render-home [] - (GET "/home" {:handler handler-home})) + ([] + (GET "/home" {:handler handler-home})) + ([message errormsg] + (POST "/home" {:format :raw + :params {:message message + :errormsg errormsg} + :handler handler-home}))) -;; ========================================================================== ;; ;; login +(hiccups/defhtml template-login [jsonobj] + [:h3 {:style "text-align: center"} (get jsonobj "title")] + (template-generic-form (get jsonobj "form")) + [:div {:style "text-align: center"}]) + (defn handler-login [response] (let [jsonobj (js->clj (js/JSON.parse response))] (notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#body) (template-generic-form jsonobj)))) + (dommy/set-html! (dommy/sel1 :#body) (template-login jsonobj)))) (defn render-login [] (GET "/login" {:handler handler-login})) -;; ========================================================================== ;; ;; login-authenticate +(defn on-login-submit-clicked [] + (when (-> (jquery "#login-form") + (.get "0") + (.checkValidity)) + (render-login-authenticate))) + (defn handler-login-authenticate [response] (let [jsonobj (js->clj (js/JSON.parse response))] (cond (get jsonobj "errormsg") - (render-login) + (do + (notifications jsonobj) + (render-login)) (get jsonobj "message") - (render-home)) - (render-menu) - (notifications jsonobj))) + (do + (dommy/set-html! (dommy/sel1 :#location) "/home") + (render-home (get jsonobj "message") ""))) + (render-menu))) (defn render-login-authenticate [] (POST "/login/authenticate" {:format :raw - :params {:dn (dommy/value (dommy/sel1 :#dn)) - :password (dommy/value (dommy/sel1 :#password))} + :params {:username (dommy/value (dommy/sel1 :#username)) + :pwd (dommy/value (dommy/sel1 :#pwd))} :handler handler-login-authenticate})) -;; ========================================================================== ;; ;; logout (defn handler-logout [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (render-home) - (render-menu) - (notifications jsonobj))) + (render-home"You are now logged out" "") + (dommy/set-html! (dommy/sel1 :#location) "/home") + (render-menu))) (defn render-logout [] (GET "/logout" {:handler handler-logout})) -;; ========================================================================== ;; ;; inetorg-view (hiccups/defhtml template-inetorg-view [jsonobj] - [:h3 {:align "center"} (get jsonobj "instructions")] + [:h3 {:style "text-align: center"} (get jsonobj "instructions")] [:div {:id "search"}] [:div {:id "results"}] [:div {:id "modify" :class "modal fade" - :role "dialog"} + :role "dialog"} [:div {:class "modal-dialog modal-lg"} [:div {:class "modal-content"} [:div {:class "modal-header"} @@ -253,22 +349,26 @@ (defn render-inetorg-view [] (GET "/inetorg/view" {:handler handler-inetorg-view})) -;; ========================================================================== ;; ;; inetorg-view-search -(defn on-inetorg-view-search-clicked [handler] - (render-inetorg-view-results)) +(defn on-inetorg-view-search-clicked [] + (when (-> (jquery "#inetorg-view-search-form") + (.get "0") + (.checkValidity)) + (render-inetorg-view-results))) + +(hiccups/defhtml template-inetorg-view-search [jsonobj] + (template-generic-form (get jsonobj "form"))) (defn handler-inetorg-view-search [response] (let [jsonobj (js->clj (js/JSON.parse response))] (auth-notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#search) (template-generic-form jsonobj "on_inetorg_view_search_clicked")) + (dommy/set-html! (dommy/sel1 :#search) (template-inetorg-view-search jsonobj)) (render-inetorg-view-results))) (defn render-inetorg-view-search [] (GET "/inetorg/view/search" {:handler handler-inetorg-view-search})) -;; ========================================================================== ;; ;; inetorg-view-results (hiccups/defhtml template-inetorg-view-results [jsonobj] @@ -323,17 +423,22 @@ :businesscategory (dommy/value (dommy/sel1 :#view-businesscategory))} :handler handler-inetorg-view-results})) -;; ========================================================================== ;; ;; inetorg-modify (defn on-inetorg-modify-clicked [cn] - (render-inetorg-modify cn)) + (when (-> (jquery "#inetorg-modify-form") + (.get "0") + (.checkValidity)) + (render-inetorg-modify cn)) + +(hiccups/defhtml template-inetorg-modify [jsonobj] + (template-generic-form (get jsonobj "form"))) (defn handler-inetorg-modify [response] (let [jsonobj (js->clj (js/JSON.parse response)) jquery (js* "$")] (auth-notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#modify-body) (template-generic-form jsonobj "on_inetorg_modify_submit_clicked")) + (dommy/set-html! (dommy/sel1 :#modify-body) (template-inetrog-modify jsonobj)) (doseq [[name value] (get jsonobj "ldapUserValues")] (dommy/set-value! (dommy/sel1 (keyword (str "#modify-" name))) value)) (.modal (jquery "#modify")))) @@ -343,7 +448,6 @@ :params {:cn cn} :handler handler-inetorg-modify})) -;; ========================================================================== ;; ;; inetorg-modify-submit (defn on-inetorg-modify-submit-clicked [] @@ -369,7 +473,6 @@ :businesscategory (dommy/value (dommy/sel1 :#modify-businesscategory))} :handler handler-inetorg-modify-submit})) -;; ========================================================================== ;; ;; inetrog-delete (defn on-inetorg-delete-clicked [cn] @@ -395,7 +498,6 @@ :params {:cn cn} :handler handler-inetorg-delete})) -;; ========================================================================== ;; ;; inetrog-delete-submit (defn on-inetorg-delete-submit-clicked [cn] @@ -412,22 +514,26 @@ :params {:cn cn} :handler handler-inetorg-delete-submit})) -;; ========================================================================== ;; ;; inetrog-add +(hiccups/defhtml template-inetorg-add [jsonobj] + (template-generic-form (get jsonobj "form"))) + (defn handler-inetorg-add [response] (let [jsonobj (js->clj (js/JSON.parse response))] (auth-notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#body) (template-generic-form jsonobj "on_inetorg_add_submit_clicked")))) + (dommy/set-html! (dommy/sel1 :#body) (template-inetorg-add jsonobj)))) (defn render-inetorg-add [] (GET "/inetorg/add" {:handler handler-inetorg-add})) -;; ========================================================================== ;; ;; inetorg-add-submit -(defn on-inetorg-add-submit-clicked [handler] - (render-inetorg-add-submit)) +(defn on-inetorg-add-submit-clicked [] + (when (-> (jquery "#inetorg-add-form") + (.get "0") + (.checkValidity)) + (render-inetorg-add-submit))) (defn handler-inetorg-add-submit [response] (let [jsonobj (js->clj (js/JSON.parse response))] @@ -449,28 +555,24 @@ :businesscategory (dommy/value (dommy/sel1 :#add-businesscategory))} :handler handler-inetorg-add-submit})) -;; ========================================================================== ;; ;; location -(hiccups/defhtml template-location [location] - [:h3 {:align "center"} location]) - (defn on-menu-clicked [handler] - (dommy/set-html! (dommy/sel1 :#location) (clojure.string/upper-case (template-location handler))) - (cond (= handler "/home") (render-home) - (= handler "/login") (render-login) - (= handler "/login/authenticate") (render-login-authenticate) - (= handler "/logout") (render-logout) - (= handler "/inetorg/view") (render-inetorg-view) - (= handler "/inetorg/add") (render-inetorg-add))) + (dommy/set-html! (dommy/sel1 :#location) handler) + (render-menu) + (cond (= handler "/home") (render-home) + (= handler "/login") (render-login) + (= handler "/login/authenticate") (render-login-authenticate) + (= handler "/logout") (render-logout) + (= handler "/inetorg/view") (render-inetorg-view) + (= handler "/inetorg/add") (render-inetorg-add))) (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) + (POST "/location" {:format :raw + :params {:location location} + :handler handler-location})) diff --git a/webapps/ldapadmin/site.lisp b/webapps/ldapadmin/site.lisp index f010186..126c479 100644 --- a/webapps/ldapadmin/site.lisp +++ b/webapps/ldapadmin/site.lisp @@ -3,9 +3,7 @@ (in-package #:ldapadmin) -;; ========================================================================== ;; - -(defmacro .base () +(defmacro .base (&optional (onload-fn "goto_location('/home')")) `(html5 `(html (head @@ -13,31 +11,37 @@ ((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"))) + `((link :rel "stylesheet" :href ,(getf css :href) :integrity ,(getf css :integrity) :crossorigin ,(getf css :crossorigin)))) + '((:href "https://maxcdn.bootstrapcdn.com/bootstrap/4.0.0/css/bootstrap.min.css" :integrity "sha384-Gn5384xqQ1aoWXA+058RXPxPg6fy4IWvTNh0E263XmFcJlSAwiGgFAW/dAiS6JXm" :crossorigin "anonymous"))) ,@(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 + `((script :type "text/javascript" :src ,(getf js :src) :integrity ,(getf js :integrity) :crossorigin ,(getf js :crossorigin)))) + '((:src "https://code.jquery.com/jquery-3.2.1.slim.min.js" :integrity "sha384-KJ3o2DKtIkvYIK3UENzmM7KCkRr/rE9/Qpg6aAZGJwFDMVNA/GpGFF93hXpG5KkN" :crossorigin "anonymous") + (:src "https://cdnjs.cloudflare.com/ajax/libs/popper.js/1.12.9/umd/popper.min.js" :integrity "sha384-ApNbgh9B+Y1QKtv3Rn7W3mgPxhU9K/ScQsAP7hUibX39j7fakFPskvXusvfa0b4Q" :crossorigin "anonymous") + (:src "https://maxcdn.bootstrapcdn.com/bootstrap/4.0.0/js/bootstrap.min.js" :integrity "sha384-JZR6Spejh4U02d8jOt6vLEHfe/JQGiRRSQQxSfFWpi1MquVdAyjUar5+76PVCmYl" :crossorigin "anonymous"))) + ((script :type "text/javascript" :src "/static/js/cljs/main.js"))) + ((body :onload ,(format nil "hworch.core.~a" ,onload-fn)) ((div :class "container-fluid") - ((div :class "page-header") - ((h2 :align "center") ,(title *webapp*))) + ((div :class "row") + ((div :class "col") " ") + ((div :class "col") + ((div :class "page-header") + ((h2 :align "center") ,(title *webapp*)))) + ((div :class "col") " ")) ((div :id "menu" :class "well")) - ((div :id "location")) + ((div :id "location" :style "display: none")) ((div :id "errormsg")) ((div :id "message")) ((div :id "body"))))))) -;; ========================================================================== ;; - (defmacro .location () - `(location-json)) + `(location-json location)) -(defmacro .home () +(defmacro .home-get () `(home-json)) +(defmacro .home-post () + `(home-json message errormsg)) + (defmacro .menu () `(menu-json)) @@ -77,11 +81,10 @@ (defmacro .inetorg-add-submit () `(inetorg-add-submit-json givenname sn mail postaladdress postalcode st l telephonenumber mobile businesscategory)) -;; ========================================================================== ;; - (define-endpoint :get "/" () .base) -(define-endpoint :get "/location" () .location) -(define-endpoint :get "/home" () .home) +(define-endpoint :post "/location" ((location :parameter-type 'string)) .location) +(define-endpoint :get "/home" () .home-get) +(define-endpoint :post "/home" ((message :parameter-type 'string) (errormsg :parameter-type 'string)) .home-post) (define-endpoint :get "/menu" () .menu) (define-endpoint :get "/login" () .login) (define-endpoint :post "/login/authenticate" ((dn :parameter-type 'string) (password :parameter-type 'string)) .login-authenticate) diff --git a/webapps/webapp-loader.lisp b/webapps/webapp-loader.lisp index c29da1f..83f1979 100644 --- a/webapps/webapp-loader.lisp +++ b/webapps/webapp-loader.lisp @@ -3,8 +3,6 @@ (in-package #:ldapadmin) -;; ========================================================================== ;; - (defvar *acceptor* nil) (defvar *dispatch-table* '(#'dispatch-easy-handlers #'default-dispatcher)) (defvar *webapps* (make-hash-table :test 'equal)) @@ -12,8 +10,6 @@ (defparameter *port* 3006) (defparameter *session-timeout* 14400) -;; ========================================================================== ;; - (defclass webapp () ((name :initarg :name :initform nil @@ -47,8 +43,6 @@ up in Google.") :accessor ldap)) (:documentation "")) -;; ========================================================================== ;; - (defgeneric get-site-file-path (webapp) (:documentation "Builds a full filesystem path to a webapp's site file.")) @@ -65,8 +59,6 @@ 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." @@ -92,8 +84,6 @@ overwritten with the new one." "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." @@ -105,8 +95,6 @@ overwritten with the new one." (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) @@ -119,8 +107,6 @@ overwritten with the new one." :meta-description (getf form :meta-description) :ldap (getf form :ldap))))))) -;; ========================================================================== ;; - (defun ldapadmin () "Call this to start the server." (when (null *acceptor*) @@ -135,8 +121,6 @@ overwritten with the new one." :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 @@ -150,8 +134,6 @@ overwritten with the new one." (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." |