summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--core/coreutils.lisp6
-rw-r--r--service/auth-service.lisp6
-rw-r--r--service/inetorg-delete-service.lisp8
-rw-r--r--service/inetorg-modify-service.lisp11
-rw-r--r--service/inetorg-view-service.lisp6
-rw-r--r--service/login-service.lisp2
-rw-r--r--service/menu-service.lisp32
-rw-r--r--service/rest-service.lisp10
-rw-r--r--webapps/ldapadmin/clojurescript/ldapadmin/src/core.cljs27
-rw-r--r--webapps/ldapadmin/site.lisp2
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") " ")
generated by cgit v1.3 (git 2.53.0) at 2026-09-24 14:20:33 +0000