summaryrefslogtreecommitdiff
path: root/service
diff options
context:
space:
mode:
Diffstat (limited to 'service')
-rw-r--r--service/auth-service.lisp21
-rw-r--r--service/base-service.lisp10
-rw-r--r--service/generic-form.lisp45
-rw-r--r--service/home.lisp18
-rw-r--r--service/inetorg-add.lisp54
-rw-r--r--service/inetorg-delete.lisp34
-rw-r--r--service/inetorg-modify.lisp58
-rw-r--r--service/inetorg-view.lisp70
-rw-r--r--service/login-authenticate.lisp24
-rw-r--r--service/login.lisp18
-rw-r--r--service/logout.lisp19
-rw-r--r--service/menu.lisp57
-rw-r--r--service/rest-service.lisp33
13 files changed, 461 insertions, 0 deletions
diff --git a/service/auth-service.lisp b/service/auth-service.lisp
new file mode 100644
index 0000000..0d0e8a0
--- /dev/null
+++ b/service/auth-service.lisp
@@ -0,0 +1,21 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package #:ldapadmin)
+
+;; ========================================================================== ;;
+
+(defclass auth-service (rest-service)
+ ()
+ (:documentation ""))
+
+(defmethod initialize-instance :after ((auth-service auth-service) &key)
+ (when (not (string= (session-value :permissions) "admin"))
+ (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)))
+ (when (null (errormsg ,instance))
+ ,@body)
+ (objects-to-json `(,,instance))))
diff --git a/service/base-service.lisp b/service/base-service.lisp
new file mode 100644
index 0000000..0f65b82
--- /dev/null
+++ b/service/base-service.lisp
@@ -0,0 +1,10 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package #:ldapadmin)
+
+;; ========================================================================== ;;
+
+(defclass base-service ()
+ ()
+ (:documentation ""))
diff --git a/service/generic-form.lisp b/service/generic-form.lisp
new file mode 100644
index 0000000..1fb9867
--- /dev/null
+++ b/service/generic-form.lisp
@@ -0,0 +1,45 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package #:ldapadmin)
+
+;; ========================================================================== ;;
+
+(defclass generic-form (rest-service)
+ ((name :initarg :name
+ :initform nil
+ :accessor name)
+ (http-method :initarg :http-method
+ :initform "POST"
+ :accessor http-method)
+ (action :initarg :action
+ :initform nil
+ :accessor action)
+ (form-fields :initarg :form-fields
+ :initform nil
+ :accessor form-fields))
+ (:documentation ""))
+
+(defclass form-field (base-service)
+ ((name :initarg :name
+ :initform nil
+ :accessor name)
+ (label :initarg :label
+ :initform nil
+ :accessor label)
+ (field-type :initarg :field-type
+ :initform nil
+ :accessor field-type))
+ (:documentation ""))
+
+(defmacro define-generic-form-constructor ((form-class name action) fields)
+ `(defmethod initialize-instance :after ((,form-class ,form-class) &key)
+ (setf (name ,form-class) ,name)
+ (setf (action ,form-class) ,action)
+ (setf (form-fields ,form-class)
+ (mapcar (lambda (form)
+ (make-instance 'form-field
+ :name (getf form :name)
+ :label (getf form :label)
+ :field-type (getf form :field-type)))
+ ,fields))))
diff --git a/service/home.lisp b/service/home.lisp
new file mode 100644
index 0000000..488b86f
--- /dev/null
+++ b/service/home.lisp
@@ -0,0 +1,18 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package #:ldapadmin)
+
+;; ========================================================================== ;;
+
+(defclass home (rest-service)
+ ((content :initarg :content
+ :initform nil
+ :accessor content))
+ (:documentation ""))
+
+(defmethod initialize-instance :after ((home home) &key)
+ (setf (content home) (concatenate 'string "Welcome to the " (title *webapp*))))
+
+(defun home-json ()
+ (objects-to-json `(,(make-instance 'home))))
diff --git a/service/inetorg-add.lisp b/service/inetorg-add.lisp
new file mode 100644
index 0000000..a55f72d
--- /dev/null
+++ b/service/inetorg-add.lisp
@@ -0,0 +1,54 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package #:ldapadmin)
+
+;; ========================================================================== ;;
+;; inetorg-add
+
+(defclass inetorg-add (auth-service generic-form)
+ ((instructions :initarg :instructions
+ :initform nil
+ :accessor instructions))
+ (:documentation ""))
+
+(define-generic-form-constructor (inetorg-add "inetorg-add-form" "/inetorg/add/submit")
+ '((:name "add-givenname" :label "givenName" :field-type "text")
+ (:name "add-sn" :label "sn" :field-type "text")
+ (:name "add-mail" :label "mail" :field-type "text")
+ (:name "add-postaladdress" :label "postalAddress" :field-type "text")
+ (:name "add-postalcode" :label "postalCode" :field-type "text")
+ (:name "add-st" :label "st" :field-type "text")
+ (:name "add-l" :label "l" :field-type "text")
+ (:name "add-telephonenumber" :label "telephoneNumber" :field-type "text")
+ (:name "add-mobile" :label "mobile" :field-type "text")
+ (:name "add-submit" :label "Create InetOrg Entry" :field-type "button")))
+
+(defun inetorg-add-json ()
+ (with-auth (instance inetorg-add)
+ (setf (instructions instance) "Use the form to add a new InetOrg entry.")))
+
+;; ========================================================================== ;;
+;; inetorg-add-submit
+
+(defclass inetorg-add-submit (auth-service)
+ ((location-p :initarg :location-p
+ :initform nil
+ :accessor location-p))
+ (:documentation ""))
+
+(defun inetorg-add-submit-json (givenname sn mail postaladdress postalcode st l telephonenumber mobile)
+ (with-auth (instance inetorg-add-submit)
+ (with-ldap (ldap)
+ (let ((ldap-user (make-instance 'ldap-user
+ :givenname givenname
+ :sn sn
+ :mail mail
+ :postaladdress postaladdress
+ :postalcode postalcode
+ :st st
+ :l l
+ :telephonenumber telephonenumber
+ :mobile mobile)))
+ (add-ldap-user ldap-user ldap)
+ (setf (message instance) "InetOrg entry created successfully.")))))
diff --git a/service/inetorg-delete.lisp b/service/inetorg-delete.lisp
new file mode 100644
index 0000000..d01db5d
--- /dev/null
+++ b/service/inetorg-delete.lisp
@@ -0,0 +1,34 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package #:ldapadmin)
+
+;; ========================================================================== ;;
+;; inetorg-delete
+
+(defclass inetorg-delete (auth-service)
+ ((cn :initarg :cn
+ :initform nil
+ :accessor cn)
+ (location-p :initarg :location-p
+ :initform nil
+ :accessor location-p))
+ (:documentation ""))
+
+(defun inetorg-delete-json (cn)
+ (with-auth (instance inetorg-delete)
+ (setf (cn instance) cn)))
+
+;; ========================================================================== ;;
+;; inetorg-delete-submit
+
+(defclass inetorg-delete-submit (auth-service)
+ ()
+ (:documentation ""))
+
+(defun inetorg-delete-submit-json (cn)
+ (with-auth (instance inetorg-delete-submit)
+ (with-ldap (ldap)
+ (let ((ldap-user (get-ldap-user ldap cn)))
+ (delete-ldap-user ldap-user ldap)
+ (setf (message instance) "InetOrg entry deleted successfully.")))))
diff --git a/service/inetorg-modify.lisp b/service/inetorg-modify.lisp
new file mode 100644
index 0000000..e1f5577
--- /dev/null
+++ b/service/inetorg-modify.lisp
@@ -0,0 +1,58 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package #:ldapadmin)
+
+;; ========================================================================== ;;
+;; inetorg-modify
+
+(defclass inetorg-modify (auth-service generic-form)
+ ((ldap-user-values :initarg :ldap-user-values
+ :initform nil
+ :accessor ldap-user-values)
+ (location-p :initarg :location-p
+ :initform nil
+ :accessor location-p))
+ (:documentation ""))
+
+(define-generic-form-constructor (inetorg-modify "inetorg-modify-form" "/inetorg/modify/submit")
+ '((: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")
+ (:name "modify-postalcode" :label "postalCode" :field-type "text")
+ (:name "modify-st" :label "st" :field-type "text")
+ (:name "modify-l" :label "l" :field-type "text")
+ (:name "modify-telephonenumber" :label "telephoneNumber" :field-type "text")
+ (:name "modify-mobile" :label "mobile" :field-type "text")
+ (:name "modify-submit" :label "Modify InetOrg Entry" :field-type "button")))
+
+(defun inetorg-modify-json (cn)
+ (with-auth (instance inetorg-modify)
+ (with-ldap (ldap)
+ (setf (ldap-user-values instance) (get-ldap-user ldap cn)))))
+
+;; ========================================================================== ;;
+;; inetorg-modify-submit
+
+(defclass inetorg-modify-submit (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)
+ (with-auth (instance inetorg-modify-submit)
+ (with-ldap (ldap)
+ (let ((ldap-user (make-instance 'ldap-user
+ :givenname givenname
+ :sn sn
+ :mail mail
+ :postaladdress postaladdress
+ :postalcode postalcode
+ :st st
+ :l l
+ :telephonenumber telephonenumber
+ :mobile mobile)))
+ (modify-ldap-user ldap-user ldap)
+ (setf (message instance) "InetOrg entry saved successfully.")))))
diff --git a/service/inetorg-view.lisp b/service/inetorg-view.lisp
new file mode 100644
index 0000000..08e7914
--- /dev/null
+++ b/service/inetorg-view.lisp
@@ -0,0 +1,70 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package #:ldapadmin)
+
+;; ========================================================================== ;;
+;; inetorg-view
+
+(defclass inetorg-view (auth-service)
+ ((instructions :initarg :instructions
+ :initform nil
+ :accessor instructions))
+ (:documentation ""))
+
+(defun inetorg-view-json ()
+ (with-auth (instance inetorg-view)
+ (setf (instructions instance) "Use the form to filter the InetOrg results.")))
+
+;; ========================================================================== ;;
+;; inetorg-view-search
+
+(defclass inetorg-view-search (auth-service generic-form)
+ ((location-p :initarg :location-p
+ :initform nil
+ :accessor location-p))
+ (:documentation ""))
+
+(define-generic-form-constructor (inetorg-view-search "inetorg-view-search-form" "/inetorg/view/results")
+ '((:name "view-givenname" :label "givenName" :field-type "text")
+ (:name "view-sn" :label "sn" :field-type "text")
+ (:name "view-mail" :label "mail" :field-type "text")
+ (:name "view-postaladdress" :label "postalAddress" :field-type "text")
+ (:name "view-postalcode" :label "postalCode" :field-type "text")
+ (:name "view-st" :label "st" :field-type "text")
+ (:name "view-l" :label "l" :field-type "text")
+ (:name "view-telephonenumber" :label "telephoneNumber" :field-type "text")
+ (:name "view-mobile" :label "mobile" :field-type "text")
+ (:name "view-submit" :label "Search InetOrg Entries" :field-type "button")))
+
+(defun inetorg-view-search-json ()
+ (with-auth (instance inetorg-view-search)
+ nil))
+
+;; ========================================================================== ;;
+;; inetorg-view-results
+
+(defclass inetorg-view-results (auth-service)
+ ((results :initarg :results
+ :initform nil
+ :accessor results)
+ (location-p :initarg :location-p
+ :initform nil
+ :accessor location-p))
+ (:documentation ""))
+
+(defun inetorg-view-results-json (givenname sn mail postaladdress postalcode st l telephonenumber mobile)
+ (with-auth (instance inetorg-view-results)
+ (with-ldap (ldap)
+ (setf (results instance)
+ (sort (search-ldap-users ldap
+ `((:givenname ,givenname)
+ (:sn ,sn)
+ (:mail ,mail)
+ (:postaladdress ,postaladdress)
+ (:postalcode ,postalcode)
+ (:st ,st)
+ (:l ,l)
+ (:telephonenumber ,telephonenumber)
+ (:mobile ,mobile)))
+ (lambda (x y) (string< (get-cn x) (get-cn y))))))))
diff --git a/service/login-authenticate.lisp b/service/login-authenticate.lisp
new file mode 100644
index 0000000..5b657a0
--- /dev/null
+++ b/service/login-authenticate.lisp
@@ -0,0 +1,24 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package #:ldapadmin)
+
+;; ========================================================================== ;;
+
+(defclass login-authenticate (rest-service)
+ ((location-p :initarg :location-p
+ :initform nil
+ :accessor location-p))
+ (:documentation ""))
+
+(defmethod initialize-instance :after ((login-authenticate login-authenticate) &key auth-result)
+ (if auth-result
+ (setf (message login-authenticate) "Successfully logged in.")
+ (setf (errormsg login-authenticate) "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))
+ (objects-to-json `(,(make-instance 'login-authenticate :auth-result auth-result)))))
diff --git a/service/login.lisp b/service/login.lisp
new file mode 100644
index 0000000..6d005d7
--- /dev/null
+++ b/service/login.lisp
@@ -0,0 +1,18 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package #:ldapadmin)
+
+;; ========================================================================== ;;
+
+(defclass login (generic-form)
+ ()
+ (:documentation ""))
+
+(define-generic-form-constructor (login "login-form" "/login/authenticate")
+ '((:name "dn" :label "DN" :field-type "text")
+ (:name "password" :label "Password" :field-type "password")
+ (:name "submit" :label "Login" :field-type "button")))
+
+(defun login-json ()
+ (objects-to-json `(,(make-instance 'login))))
diff --git a/service/logout.lisp b/service/logout.lisp
new file mode 100644
index 0000000..219e7e2
--- /dev/null
+++ b/service/logout.lisp
@@ -0,0 +1,19 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package #:ldapadmin)
+
+;; ========================================================================== ;;
+
+(defclass logout (rest-service)
+ ((location-p :initarg :location-p
+ :initform nil
+ :accessor location-p))
+ (:documentation ""))
+
+(defmethod initialize-instance :after ((logout logout) &key)
+ (setf (message logout) "You are now logged out."))
+
+(defun logout-json ()
+ (setf (session-value :permissions) "anonymous")
+ (objects-to-json `(,(make-instance 'logout))))
diff --git a/service/menu.lisp b/service/menu.lisp
new file mode 100644
index 0000000..069cb11
--- /dev/null
+++ b/service/menu.lisp
@@ -0,0 +1,57 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package #:ldapadmin)
+
+;; ========================================================================== ;;
+
+(defparameter *menu-config* '((:id "a_menu_home" :label "Home" :url "/home" :handler "/home" :permission "t")
+ (:id "a_menu_login" :label "Login" :url "/login" :handler "/login" :permission "anonymous")
+ (:id "a_menu_logout" :label "Logout" :url "/logout" :handler "/logout" :permission "admin")
+ (:id "a_menu_inetorg_view" :label "View InetOrg Entries" :url "/inetorg/view" :handler "/inetorg/view" :permission "admin")
+ (:id "a_menu_inetorg_add" :label "Add InetOrg Entry" :url "/inetorg/add" :handler "/inetorg/add" :permission "admin")))
+
+(defclass menuitem ()
+ ((id :initarg :id
+ :initform nil
+ :accessor id)
+ (label :initarg :label
+ :initform nil
+ :accessor label)
+ (url :initarg :url
+ :initform nil
+ :accessor url)
+ (handler :initarg :handler
+ :initform nil
+ :accessor handler)
+ (permissions :initarg :permissions
+ :initform nil
+ :accessor permissions)
+ (children :initarg :children
+ :initform nil
+ :accessor children))
+ (:documentation ""))
+
+(defclass menu (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*)))))
+
+(defun menu-json ()
+ (objects-to-json `(,(make-instance 'menu))))
diff --git a/service/rest-service.lisp b/service/rest-service.lisp
new file mode 100644
index 0000000..693463f
--- /dev/null
+++ b/service/rest-service.lisp
@@ -0,0 +1,33 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package #:ldapadmin)
+
+;; ========================================================================== ;;
+
+(defclass rest-service (base-service)
+ ((location :initarg :location
+ :initform nil
+ :accessor location)
+ (location-p :initarg :location-p
+ :initform t
+ :accessor location-p)
+ (errormsg :initarg :errormsg
+ :initform nil
+ :accessor errormsg)
+ (message :initarg :message
+ :initform nil
+ :accessor message))
+ (: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))
+ (setf (session-value :location) (location rest-service))))
+
+(defun location-json ()
+ (let ((location (if (session-value :location) (session-value :location) "/home")))
+ (format nil "{\"location\":\"~a\"}" location)))
+
+(defun type-to-path (rest-type)
+ (concatenate 'string "/" (ppcre:regex-replace "-" (string-downcase (type-of rest-type)) "/")))
generated by cgit v1.3 (git 2.53.0) at 2026-09-24 14:26:39 +0000