summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--service/auth-service.lisp11
-rw-r--r--service/home-service.lisp6
-rw-r--r--service/inetorg-add-service.lisp6
-rw-r--r--service/inetorg-delete-service.lisp8
-rw-r--r--service/inetorg-modify-service.lisp10
-rw-r--r--service/inetorg-view-service.lisp12
-rw-r--r--service/login-service.lisp28
-rw-r--r--service/logout-service.lisp4
-rw-r--r--service/menu-service.lisp5
-rw-r--r--service/rest-service.lisp19
-rw-r--r--webapps/ldapadmin/clojurescript/ldapadmin/src/core.cljs64
-rw-r--r--webapps/ldapadmin/site.lisp8
12 files changed, 89 insertions, 92 deletions
diff --git a/service/auth-service.lisp b/service/auth-service.lisp
index e5e7e27..1702bde 100644
--- a/service/auth-service.lisp
+++ b/service/auth-service.lisp
@@ -16,4 +16,15 @@
`(let ((,instance (make-instance ',auth-service)))
(when (string= (session-value :permissions) "admin")
,@body)
+ (when (location-p ,instance)
+ (setf (session-value :message) nil)
+ (setf (session-value :errormsg) nil))
(org-ckons-json::objects-to-json `(,,instance))))
+
+(defmacro with-noauth ((instance rest-service) &body body)
+ `(let ((,instance (make-instance ',rest-service)))
+ ,@body
+ (when (location-p ,instance)
+ (setf (session-value :message) nil)
+ (setf (session-value :errormsg) nil))
+ (org-ckons-json::objects-to-json `(,,instance))))
diff --git a/service/home-service.lisp b/service/home-service.lisp
index 2685264..5379a9f 100644
--- a/service/home-service.lisp
+++ b/service/home-service.lisp
@@ -13,6 +13,6 @@
(setf (content home-service) (format nil "Welcome to the ~a website" (title *webapp*))))
(defun home-json (&optional message errormsg)
- (org-ckons-json::objects-to-json `(,(make-instance 'home-service
- :message message
- :errormsg errormsg))))
+ (with-noauth (instance home-service)
+ (when message (setf (message instance) message))
+ (when errormsg (setf (errormsg instance) errormsg))))
diff --git a/service/inetorg-add-service.lisp b/service/inetorg-add-service.lisp
index 9647060..681da97 100644
--- a/service/inetorg-add-service.lisp
+++ b/service/inetorg-add-service.lisp
@@ -34,9 +34,7 @@
t))
(defclass inetorg-add-submit-service (auth-service)
- ((location-p :initarg :location-p
- :initform nil
- :accessor location-p))
+ ((location-p :initform nil))
(:documentation ""))
(defun inetorg-add-submit-json (givenname sn mail postaladdress postalcode st l telephonenumber mobile businesscategory)
@@ -54,4 +52,4 @@
:mobile mobile
:businesscategory businesscategory)))
(add-ldap-user ldap-user ldap)
- (setf (message instance) "InetOrg entry created successfully.")))))
+ (setf (session-value :message) "InetOrg entry created successfully.")))))
diff --git a/service/inetorg-delete-service.lisp b/service/inetorg-delete-service.lisp
index 8756f64..9f545cd 100644
--- a/service/inetorg-delete-service.lisp
+++ b/service/inetorg-delete-service.lisp
@@ -7,9 +7,7 @@
((cn :initarg :cn
:initform nil
:accessor cn)
- (location-p :initarg :location-p
- :initform nil
- :accessor location-p))
+ (location-p :initform nil))
(:documentation ""))
(defun inetorg-delete-json (cn)
@@ -17,7 +15,7 @@
(setf (cn instance) cn)))
(defclass inetorg-delete-submit-service (auth-service)
- ()
+ ((location-p :initform nil))
(:documentation ""))
(defun inetorg-delete-submit-json (cn)
@@ -25,4 +23,4 @@
(with-ldap (ldap)
(let ((ldap-user (get-ldap-user ldap cn)))
(delete-ldap-user ldap-user ldap)
- (setf (message instance) "InetOrg entry deleted successfully.")))))
+ (setf (session-value :message) "InetOrg entry deleted successfully.")))))
diff --git a/service/inetorg-modify-service.lisp b/service/inetorg-modify-service.lisp
index 61e7c16..47ca6cd 100644
--- a/service/inetorg-modify-service.lisp
+++ b/service/inetorg-modify-service.lisp
@@ -13,9 +13,7 @@
(title :initarg :title
:initform nil
:accessor title)
- (location-p :initarg :location-p
- :initform nil
- :accessor location-p))
+ (location-p :initform nil))
(:documentation ""))
(defmethod initialize-instance :after ((inetorg-modify-service inetorg-modify-service) &key)
@@ -40,9 +38,7 @@
(setf (ldap-user-values instance) (get-ldap-user ldap cn)))))
(defclass inetorg-modify-submit-service (auth-service)
- ((location-p :initarg :location-p
- :initform nil
- :accessor location-p))
+ ((location-p :initform nil))
(:documentation ""))
(defun inetorg-modify-submit-json (givenname sn mail postaladdress postalcode st l telephonenumber mobile businesscategory)
@@ -60,4 +56,4 @@
:mobile mobile
:businesscategory businesscategory)))
(modify-ldap-user ldap-user ldap)
- (setf (message instance) "InetOrg entry saved successfully.")))))
+ (setf (session-value :message) "InetOrg entry saved successfully.")))))
diff --git a/service/inetorg-view-service.lisp b/service/inetorg-view-service.lisp
index 7beeed3..ab89123 100644
--- a/service/inetorg-view-service.lisp
+++ b/service/inetorg-view-service.lisp
@@ -11,8 +11,8 @@
(defun inetorg-view-json (&optional message errormsg)
(with-auth (instance inetorg-view-service)
- (setf (message instance) message)
- (setf (errormsg instance) errormsg)
+ (when message (setf (message instance) message))
+ (when errormsg (setf (errormsg instance) errormsg))
(setf (title instance) "Use the form to filter the InetOrg results.")))
(defclass inetorg-view-search-service (auth-service)
@@ -22,9 +22,7 @@
(title :initarg :title
:initform nil
:accessor title)
- (location-p :initarg :location-p
- :initform nil
- :accessor location-p))
+ (location-p :initform nil))
(:documentation ""))
(defmethod initialize-instance :after ((inetorg-view-search-service inetorg-view-search-service) &key)
@@ -51,9 +49,7 @@
((results :initarg :results
:initform nil
:accessor results)
- (location-p :initarg :location-p
- :initform nil
- :accessor location-p))
+ (location-p :initform nil))
(:documentation ""))
(defun inetorg-view-results-json (givenname sn mail postaladdress postalcode st l telephonenumber mobile businesscategory)
diff --git a/service/login-service.lisp b/service/login-service.lisp
index 10e0722..a911c49 100644
--- a/service/login-service.lisp
+++ b/service/login-service.lisp
@@ -22,22 +22,22 @@
(:label "Login" :field-type "button" :onclick "on_login_submit_clicked()")))))
(defun login-json ()
- (org-ckons-json::objects-to-json `(,(make-instance 'login-service))))
+ (with-noauth (instance login-service)
+ nil))
(defclass login-authenticate-service (rest-service)
- ((location-p :initarg :location-p
- :initform nil
- :accessor location-p))
+ ((location-p :initform nil))
(:documentation ""))
-(defmethod initialize-instance :after ((login-authenticate-service login-authenticate-service) &key auth-result)
- (if auth-result
- (setf (message login-authenticate-service) "Successfully logged in.")
- (setf (errormsg login-authenticate-service) "Login failed.")))
-
(defun login-authenticate-json (dn password)
- (let ((auth-result nil))
- (when (check-ldap-password (ldap *webapp*) dn password)
- (setf (session-value :permissions) "admin")
- (setf auth-result t))
- (org-ckons-json::objects-to-json `(,(make-instance 'login-authenticate-service :auth-result auth-result)))))
+ (with-noauth (instance login-authenticate-service)
+ (cond ((check-ldap-password (ldap *webapp*) dn password)
+ (setf (session-value :permissions) "admin")
+ (setf (session-value :message) "Successfully logged in.")
+ (setf (session-value :errormsg) nil))
+ (t
+ (setf (session-value :message) nil)
+ (setf (session-value :errormsg) "Login failed.")))
+ (setf (message instance) (session-value :message))
+ (setf (errormsg instance) (session-value :errormsg))))
+
diff --git a/service/logout-service.lisp b/service/logout-service.lisp
index 208c419..54a02b4 100644
--- a/service/logout-service.lisp
+++ b/service/logout-service.lisp
@@ -4,9 +4,7 @@
(in-package #:ldapadmin)
(defclass logout-service (rest-service)
- ((location-p :initarg :location-p
- :initform nil
- :accessor location-p))
+ ((location-p :initform nil))
(:documentation ""))
(defmethod initialize-instance :after ((logout-service logout-service) &key)
diff --git a/service/menu-service.lisp b/service/menu-service.lisp
index 8ea0515..86d114b 100644
--- a/service/menu-service.lisp
+++ b/service/menu-service.lisp
@@ -33,7 +33,10 @@
(defclass menu-service (base-service)
((menuitems :initarg :menuitems
:initform nil
- :accessor menuitems))
+ :accessor menuitems)
+ (location-p :initarg :location-p
+ :initform nil
+ :accessor location-p))
(:documentation ""))
(defmethod initialize-instance :after ((menu-service menu-service) &key)
diff --git a/service/rest-service.lisp b/service/rest-service.lisp
index 3c122f7..e57af23 100644
--- a/service/rest-service.lisp
+++ b/service/rest-service.lisp
@@ -10,17 +10,24 @@
(location-p :initarg :location-p
:initform t
:accessor location-p)
- (errormsg :initarg :errormsg
- :initform nil
- :accessor errormsg)
(message :initarg :message
:initform nil
- :accessor message))
+ :accessor message)
+ (errormsg :initarg :errormsg
+ :initform nil
+ :accessor errormsg))
(:documentation ""))
(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))))
+ (when (location-p rest-service)
+ (if (message rest-service)
+ (setf (session-value :message) (message rest-service))
+ (setf (message rest-service) (session-value :message)))
+ (if (errormsg rest-service)
+ (setf (session-value :errormsg) (errormsg rest-service))
+ (setf (errormsg rest-service) (session-value :errormsg)))
+ (when (null (location rest-service))
+ (setf (location rest-service) (type-to-path rest-service)))))
(defun location-json (&optional (location "/home"))
(format nil "{\"location\":\"~a\"}" location))
diff --git a/webapps/ldapadmin/clojurescript/ldapadmin/src/core.cljs b/webapps/ldapadmin/clojurescript/ldapadmin/src/core.cljs
index 2a6d489..649daf7 100644
--- a/webapps/ldapadmin/clojurescript/ldapadmin/src/core.cljs
+++ b/webapps/ldapadmin/clojurescript/ldapadmin/src/core.cljs
@@ -72,33 +72,35 @@
(hiccups/defhtml template-message [message]
[:div {:class "alert alert-success"} message])
-(defn maybe-error [jsonobj]
- (let [errormsg (get jsonobj "errormsg")]
- (cond (empty? 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]
- (let [message (get jsonobj "message")]
- (cond (empty? 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))))))
+ (when (get jsonobj "locationP")
+ (let [message (get jsonobj "message")]
+ (cond (empty? 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 maybe-error [jsonobj]
+ (when (get jsonobj "locationP")
+ (let [errormsg (get jsonobj "errormsg")]
+ (cond (empty? 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 notifications [jsonobj]
- (maybe-error jsonobj)
- (maybe-message jsonobj))
+ (maybe-message jsonobj)
+ (maybe-error jsonobj))
(defn auth-notifications [jsonobj]
(cond (empty? (get jsonobj "errormsg"))
- (maybe-message jsonobj)
+ (notifications jsonobj)
:else
(do
(render-home "" (get jsonobj "errormsg"))
@@ -268,14 +270,12 @@
(defn handler-login-authenticate [response]
(let [jsonobj (js->clj (js/JSON.parse response))]
(cond (get jsonobj "errormsg")
- (do
- (notifications jsonobj)
- (render-login))
+ (goto-location "/login")
(get jsonobj "message")
(do
(dommy/set-html! (dommy/sel1 :#location) "/inetorg/view")
- (render-inetorg-view (get jsonobj "message") "")))
- (render-menu)))
+ (render-inetorg-view)
+ (render-menu)))))
(defn render-login-authenticate []
(POST "/login/authenticate" {:format :raw
@@ -320,9 +320,9 @@
:data-dismiss "modal"}
[:span {:class "glyphicon glyphicon-remove"}]
"Cancel"]]]]]
- [:div {:id "delete"
+ [:div {:id "delete"
:class "modal fade"
- :role "dialog"}
+ :role "dialog"}
[:div {:class "modal-dialog"}
[:div {:class "modal-content"}
[:div {:class "modal-header"}
@@ -346,14 +346,8 @@
(dommy/set-html! (dommy/sel1 :#body) (template-inetorg-view jsonobj))
(render-inetorg-view-search)))
-(defn render-inetorg-view
- ([]
+(defn render-inetorg-view []
(GET "/inetorg/view" {:handler handler-inetorg-view}))
- ([message errormsg]
- (POST "/inetorg/view" {:format :raw
- :params {:message message
- :errormsg errormsg}
- :handler handler-inetorg-view})))
;; inetorg-view-search
diff --git a/webapps/ldapadmin/site.lisp b/webapps/ldapadmin/site.lisp
index 891c9f9..eb644bd 100644
--- a/webapps/ldapadmin/site.lisp
+++ b/webapps/ldapadmin/site.lisp
@@ -55,12 +55,9 @@
(defmacro .logout ()
`(logout-json))
-(defmacro .inetorg-view-get ()
+(defmacro .inetorg-view ()
`(inetorg-view-json))
-(defmacro .inetorg-view-post ()
- `(inetorg-view-json message errormsg))
-
(defmacro .inetorg-view-search ()
`(inetorg-view-search-json))
@@ -93,8 +90,7 @@
(define-endpoint :get "/login" () .login)
(define-endpoint :post "/login/authenticate" ((dn :parameter-type 'string) (password :parameter-type 'string)) .login-authenticate)
(define-endpoint :get "/logout" () .logout)
-(define-endpoint :get "/inetorg/view" () .inetorg-view-get)
-(define-endpoint :post "/inetorg/view" ((message :parameter-type 'string) (errormsg :parameter-type 'string)) .inetorg-view-post)
+(define-endpoint :get "/inetorg/view" () .inetorg-view)
(define-endpoint :get "/inetorg/view/search" () .inetorg-view-search)
(define-endpoint :post "/inetorg/view/results" ((givenname :parameter-type 'string) (sn :parameter-type 'string) (mail :parameter-type 'string) (postaladdress :parameter-type 'string) (postalcode :parameter-type 'string) (st :parameter-type 'string) (l :parameter-type 'string) (telephonenumber :parameter-type 'string) (mobile :parameter-type 'string) (businesscategory :parameter-type 'string)) .inetorg-view-results)
(define-endpoint :post "/inetorg/modify" ((cn :parameter-type 'string)) .inetorg-modify)
generated by cgit v1.3 (git 2.53.0) at 2026-09-24 13:52:43 +0000