updated to latest bootstrap

10 files changed, 54 insertions, 56 deletions

diff --git a/core/coreutils.lisp b/core/coreutils.lisp
index 8279766..e7362d8 100644
--- a/core/coreutils.lisp
+++ b/core/coreutils.lisp
@@ -1,9 +1,9 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 (declaim (optimize (speed 0) (safety 3) (debug 3)))
 
-(defpackage #:ldapadmin
-  (:use #:cl #:cl-log #:hunchentoot)
-  (:export #:ldapadmin))
+(defpackage :ldapadmin
+  (:use :cl :cl-log :hunchentoot)
+  (:export :ldapadmin))
 
 (in-package #:ldapadmin)
 
diff --git a/service/auth-service.lisp b/service/auth-service.lisp
index 2cdc7bf..24556b7 100644
--- a/service/auth-service.lisp
+++ b/service/auth-service.lisp
@@ -9,11 +9,11 @@
 
 (defmethod initialize-instance :after ((auth-service auth-service) &key)
   (when (not (string= (session-value :permissions) "admin"))
-    (setf (location auth-service) "home")
+    (setf (location auth-service) "/home")
     (setf (errormsg auth-service) "You are not authorized to access this resource.")))
 
-(defmacro with-auth ((instance form-class) &body body)
-  `(let ((,instance (make-instance ',form-class)))
+(defmacro with-auth ((instance auth-service) &body body)
+  `(let ((,instance (make-instance ',auth-service)))
      (when (null (errormsg ,instance))
        ,@body)
      (objects-to-json `(,,instance))))
diff --git a/service/inetorg-delete-service.lisp b/service/inetorg-delete-service.lisp
index 1bcac65..8756f64 100644
--- a/service/inetorg-delete-service.lisp
+++ b/service/inetorg-delete-service.lisp
@@ -3,7 +3,7 @@
 
 (in-package #:ldapadmin)
 
-(defclass inetorg-delete (auth-service)
+(defclass inetorg-delete-service (auth-service)
   ((cn :initarg :cn
        :initform nil
        :accessor cn)
@@ -13,15 +13,15 @@
   (:documentation ""))
 
 (defun inetorg-delete-json (cn)
-  (with-auth (instance inetorg-delete)
+  (with-auth (instance inetorg-delete-service)
     (setf (cn instance) cn)))
 
-(defclass inetorg-delete-submit (auth-service)
+(defclass inetorg-delete-submit-service (auth-service)
   ()
   (:documentation ""))
 
 (defun inetorg-delete-submit-json (cn)
-  (with-auth (instance inetorg-delete-submit)
+  (with-auth (instance inetorg-delete-submit-service)
     (with-ldap (ldap)
       (let ((ldap-user (get-ldap-user ldap cn)))
         (delete-ldap-user ldap-user ldap)
diff --git a/service/inetorg-modify-service.lisp b/service/inetorg-modify-service.lisp
index 293c43b..61e7c16 100644
--- a/service/inetorg-modify-service.lisp
+++ b/service/inetorg-modify-service.lisp
@@ -7,6 +7,9 @@
   ((form :initarg :form
          :initform nil
          :accessor form)
+   (ldap-user-values :initarg :ldap-user-values
+                     :initform nil
+                     :accessor ldap-user-values)
    (title :initarg :title
           :initform nil
           :accessor title)
@@ -19,7 +22,7 @@
   (setf (form inetorg-modify-service) (make-form "inetorg-modify-form"
                                                  nil
                                                  t
-                                                 '((:name "modify-givenname" :label "givenName" :field-type "text" :value )
+                                                 `((:name "modify-givenname" :label "givenName" :field-type "text")
                                                    (:name "modify-sn" :label "sn" :field-type "text")
                                                    (:name "modify-mail" :label "mail" :field-type "text")
                                                    (:name "modify-postaladdress" :label "postalAddress" :field-type "text")
@@ -29,21 +32,21 @@
                                                    (:name "modify-telephonenumber" :label "telephoneNumber" :field-type "text")
                                                    (:name "modify-mobile" :label "mobile" :field-type "text")
                                                    (:name "modify-businesscategory" :label "businessCategory" :field-type "text")
-                                                   (:label "Modify InetOrg Entry" :field-type "button")))
+                                                   (:label "Modify InetOrg Entry" :field-type "button" :onclick "on_inetorg_modify_submit_clicked()")))))
 
 (defun inetorg-modify-json (cn)
   (with-auth (instance inetorg-modify-service)
     (with-ldap (ldap)
       (setf (ldap-user-values instance) (get-ldap-user ldap cn)))))
 
-(defclass inetorg-modify-submit (auth-service)
+(defclass inetorg-modify-submit-service (auth-service)
   ((location-p :initarg :location-p
                :initform nil
                :accessor location-p))
   (:documentation ""))
 
 (defun inetorg-modify-submit-json (givenname sn mail postaladdress postalcode st l telephonenumber mobile businesscategory)
-  (with-auth (instance inetorg-modify-submit)
+  (with-auth (instance inetorg-modify-submit-service)
     (with-ldap (ldap)
       (let ((ldap-user (make-instance 'ldap-user
                                       :givenname givenname
diff --git a/service/inetorg-view-service.lisp b/service/inetorg-view-service.lisp
index 5cbd0c6..370fdc6 100644
--- a/service/inetorg-view-service.lisp
+++ b/service/inetorg-view-service.lisp
@@ -3,14 +3,14 @@
 
 (in-package #:ldapadmin)
 
-(defclass inetorg-view (auth-service)
+(defclass inetorg-view-service (auth-service)
   ((title :initarg :title
           :initform nil
           :accessor title))
   (:documentation ""))
 
 (defun inetorg-view-json ()
-  (with-auth (instance inetorg-view)
+  (with-auth (instance inetorg-view-service)
     (setf (title instance) "Use the form to filter the InetOrg results.")))
 
 (defclass inetorg-view-search-service (auth-service)
@@ -45,7 +45,7 @@
   (with-auth (instance inetorg-view-search-service)
     nil))
 
-(defclass inetorg-view-results (auth-service)
+(defclass inetorg-view-results-service (auth-service)
   ((results :initarg :results
             :initform nil
             :accessor results)
diff --git a/service/login-service.lisp b/service/login-service.lisp
index 8de0ec5..7007327 100644
--- a/service/login-service.lisp
+++ b/service/login-service.lisp
@@ -35,7 +35,7 @@
       (setf (message login-authenticate-service) "Successfully logged in.")
       (setf (errormsg login-authenticate-service) "Login failed.")))
 
-(defun login-authenticate-json (username pwd)
+(defun login-authenticate-json (dn password)
   (let ((auth-result nil))
     (when (check-ldap-password (ldap *webapp*) dn password)
       (setf (session-value :permissions) "admin")
diff --git a/service/menu-service.lisp b/service/menu-service.lisp
index 25cad07..8ee9c25 100644
--- a/service/menu-service.lisp
+++ b/service/menu-service.lisp
@@ -30,26 +30,26 @@
              :accessor children))
   (:documentation ""))
   
-(defclass menu (base-service)
+(defclass menu-service (base-service)
   ((menuitems :initarg :menuitems
               :initform nil
               :accessor menuitems))
   (:documentation ""))
 
-(defmethod initialize-instance :after ((menu menu) &key)
-  (setf (menuitems menu)
-            (mapcar (lambda (x)
-                      (make-instance 'menuitem
-                                     :id (getf x :id)
-                                     :label (getf x :label)
-                                     :url (getf x :url)
-                                     :handler (getf x :handler)))
-                    (remove-if 'null (mapcar (lambda (x)
-                                               (when (find-if (lambda (y)
-                                                                (string= (getf x :permission) y))
-                                                              `("t" ,(session-value :permissions)))
-                                                 x))
-                                             *menu-config*)))))
+(defmethod initialize-instance :after ((menu-service menu-service) &key)
+  (setf (menuitems menu-service)
+        (mapcar (lambda (x)
+                  (make-instance 'menuitem
+                                 :id (getf x :id)
+                                 :label (getf x :label)
+                                 :url (getf x :url)
+                                 :handler (getf x :handler)))
+                (remove-if 'null (mapcar (lambda (x)
+                                           (when (find-if (lambda (y)
+                                                            (string= (getf x :permission) y))
+                                                          `("t" ,(session-value :permissions)))
+                                             x))
+                                         *menu-config*)))))
 
 (defun menu-json ()
-  (objects-to-json `(,(make-instance 'menu))))
+  (objects-to-json `(,(make-instance 'menu-service))))
diff --git a/service/rest-service.lisp b/service/rest-service.lisp
index b34817f..3c122f7 100644
--- a/service/rest-service.lisp
+++ b/service/rest-service.lisp
@@ -20,12 +20,10 @@
 
 (defmethod initialize-instance :after ((rest-service rest-service) &key)
   (when (and (location-p rest-service) (null (location rest-service)))
-    (setf (location rest-service) (type-to-path rest-service))
-    (setf (session-value :location) (location rest-service))))
+    (setf (location rest-service) (type-to-path rest-service))))
 
-(defun location-json ()
-  (let ((location (if (session-value :location) (session-value :location) "/home")))
-  (format nil "{\"location\":\"~a\"}" location)))
+(defun location-json (&optional (location "/home"))
+  (format nil "{\"location\":\"~a\"}" location))
 
 (defun type-to-path (rest-type)
-  (concatenate 'string "/" (ppcre:regex-replace "-" (string-downcase (type-of rest-type)) "/")))
+  (concatenate 'string "/" (ppcre:regex-replace "-service" (string-downcase (type-of rest-type)) "/")))
diff --git a/webapps/ldapadmin/clojurescript/ldapadmin/src/core.cljs b/webapps/ldapadmin/clojurescript/ldapadmin/src/core.cljs
index e7ef977..d7ac618 100644
--- a/webapps/ldapadmin/clojurescript/ldapadmin/src/core.cljs
+++ b/webapps/ldapadmin/clojurescript/ldapadmin/src/core.cljs
@@ -2,7 +2,8 @@
   (:require-macros [hiccups.core :as hiccups :refer [html]])
   (:require [ajax.core :refer [GET POST]]
             [dommy.core :as dommy]
-            [hiccups.runtime :as hiccupsrt]))
+            [hiccups.runtime :as hiccupsrt]
+            [clojure.string :as str]))
 
 ;; declarations
 
@@ -106,7 +107,7 @@
   
 ;; forms
 
-(hiccups/defhtml template-generic-form
+(hiccups/defhtml template-generic-form [jsonobj]
    [:div {:id "form-errormsg"}]
    [:form {:name (get jsonobj "name")
            :id (get jsonobj "name")
@@ -207,8 +208,8 @@
   [:ul {:class "nav nav-pills"}
    (for [menuitem menuitems]
      [:li {:class "nav-item"}
-      [:a {:class (cond (= (clojure.string/upper-case (get menuitem "handler"))
-                           (clojure.string/upper-case (dommy/html (dommy/sel1 :#location))))
+      [:a {:class (cond (= (str/upper-case (get menuitem "handler"))
+                           (str/upper-case (dommy/html (dommy/sel1 :#location))))
                         "nav-link active"
                         :else
                         "nav-link")
@@ -233,7 +234,7 @@
     (notifications jsonobj)
     (dommy/set-html! (dommy/sel1 :#body) (template-home jsonobj))))
 
-(defn render-home []
+(defn render-home
   ([]
    (GET "/home" {:handler handler-home}))
   ([message errormsg]
@@ -279,8 +280,8 @@
 
 (defn render-login-authenticate []
   (POST "/login/authenticate" {:format :raw
-                               :params {:username (dommy/value (dommy/sel1 :#username))
-                                        :pwd (dommy/value (dommy/sel1 :#pwd))}
+                               :params {:dn (dommy/value (dommy/sel1 :#dn))
+                                        :password (dommy/value (dommy/sel1 :#password))}
                                :handler handler-login-authenticate}))
 
 ;; logout
@@ -426,10 +427,7 @@
 ;; inetorg-modify
 
 (defn on-inetorg-modify-clicked [cn]
-  (when (-> (jquery "#inetorg-modify-form")
-            (.get "0")
-            (.checkValidity))
-    (render-inetorg-modify cn))
+  (render-inetorg-modify cn))
 
 (hiccups/defhtml template-inetorg-modify [jsonobj]
   (template-generic-form (get jsonobj "form")))
@@ -438,7 +436,7 @@
   (let [jsonobj (js->clj (js/JSON.parse response))
         jquery (js* "$")]
     (auth-notifications jsonobj)
-    (dommy/set-html! (dommy/sel1 :#modify-body) (template-inetrog-modify jsonobj))
+    (dommy/set-html! (dommy/sel1 :#modify-body) (template-inetorg-modify jsonobj))
     (doseq [[name value] (get jsonobj "ldapUserValues")]
       (dommy/set-value! (dommy/sel1 (keyword (str "#modify-" name))) value))
     (.modal (jquery "#modify"))))
@@ -451,12 +449,12 @@
 ;; inetorg-modify-submit
 
 (defn on-inetorg-modify-submit-clicked []
+  (.modal (jquery "#modify") "hide")
   (render-inetorg-modify-submit))
 
 (defn handler-inetorg-modify-submit [response]
   (let [jsonobj (js->clj (js/JSON.parse response))]
     (auth-notifications jsonobj)
-    (notifications jsonobj)
     (on-menu-clicked "/inetorg/view")))
 
 (defn render-inetorg-modify-submit []
@@ -506,7 +504,6 @@
 (defn handler-inetorg-delete-submit [response]
   (let [jsonobj (js->clj (js/JSON.parse response))]
     (auth-notifications jsonobj)
-    (notifications jsonobj)
     (on-menu-clicked "/inetorg/view")))
 
 (defn render-inetorg-delete-submit [cn]
@@ -572,7 +569,7 @@
     (on-menu-clicked (get jsonobj "location"))
     (notifications jsonobj)))
 
-(defn goto-location []
+(defn goto-location [location]
   (POST "/location" {:format :raw
                      :params {:location location}
                      :handler handler-location}))
diff --git a/webapps/ldapadmin/site.lisp b/webapps/ldapadmin/site.lisp
index 126c479..5deddf5 100644
--- a/webapps/ldapadmin/site.lisp
+++ b/webapps/ldapadmin/site.lisp
@@ -19,7 +19,7 @@
                    (: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))
+      ((body :onload ,(format nil "ldapadmin.core.~a" ,onload-fn))
        ((div :class "container-fluid")
         ((div :class "row")
          ((div :class "col") " ")