summaryrefslogtreecommitdiff
path: root/lisp/service
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/service')
-rw-r--r--lisp/service/auth-service.lisp30
-rw-r--r--lisp/service/base-service.lisp8
-rw-r--r--lisp/service/generic-form.lisp87
-rw-r--r--lisp/service/home-service.lisp18
-rw-r--r--lisp/service/inetorg-add-service.lisp55
-rw-r--r--lisp/service/inetorg-delete-service.lisp26
-rw-r--r--lisp/service/inetorg-modify-service.lisp59
-rw-r--r--lisp/service/inetorg-view-service.lisp70
-rw-r--r--lisp/service/login-service.lisp43
-rw-r--r--lisp/service/logout-service.lisp14
-rw-r--r--lisp/service/menu-service.lisp55
-rw-r--r--lisp/service/rest-service.lisp36
12 files changed, 501 insertions, 0 deletions
diff --git a/lisp/service/auth-service.lisp b/lisp/service/auth-service.lisp
new file mode 100644
index 0000000..0a84264
--- /dev/null
+++ b/lisp/service/auth-service.lisp
@@ -0,0 +1,30 @@
+;;; -*- 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 auth-service) &body body)
+ `(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/lisp/service/base-service.lisp b/lisp/service/base-service.lisp
new file mode 100644
index 0000000..7eb8fb3
--- /dev/null
+++ b/lisp/service/base-service.lisp
@@ -0,0 +1,8 @@
+;;; -*- 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/lisp/service/generic-form.lisp b/lisp/service/generic-form.lisp
new file mode 100644
index 0000000..6e0c821
--- /dev/null
+++ b/lisp/service/generic-form.lisp
@@ -0,0 +1,87 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :ldapadmin)
+
+(defclass generic-form (base-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)
+ (required-p :initarg :required-p
+ :initform nil
+ :accessor required-p)
+ (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)
+ (value :initarg :value
+ :initform nil
+ :accessor value)
+ (checked :initarg :checked
+ :initform nil
+ :accessor checked)
+ (field-type :initarg :field-type
+ :initform nil
+ :accessor field-type)
+ (required :initarg :required
+ :initform nil
+ :accessor required)
+ (dismiss :initarg :dismiss
+ :initform nil
+ :accessor dismiss)
+ (options :initarg :options
+ :initform nil
+ :accessor options)
+ (onclick :initarg :onclick
+ :initform nil
+ :accessor onclick)
+ (onchange :initarg :onchange
+ :initform nil
+ :accessor onchange))
+ (:documentation ""))
+
+(defclass option (base-service)
+ ((label :initarg :label
+ :initform nil
+ :accessor label)
+ (value :initarg :value
+ :initform nil
+ :accessor value))
+ (:documentation ""))
+
+(defun make-form (name action required-p fields)
+ (make-instance 'generic-form
+ :name name
+ :action action
+ :required-p required-p
+ :form-fields (mapcar (lambda (field)
+ (make-instance 'form-field
+ :name (getf field :name)
+ :label (getf field :label)
+ :value (getf field :value)
+ :checked (getf field :checked)
+ :field-type (getf field :field-type)
+ :required (getf field :required)
+ :dismiss (getf field :dismiss)
+ :options (mapcar (lambda (option)
+ (make-instance 'option
+ :label (getf option :label)
+ :value (getf option :value)))
+ (getf field :options))
+ :onclick (getf field :onclick)
+ :onchange (getf field :onchange)))
+ fields)))
diff --git a/lisp/service/home-service.lisp b/lisp/service/home-service.lisp
new file mode 100644
index 0000000..b914cae
--- /dev/null
+++ b/lisp/service/home-service.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-service (rest-service)
+ ((content :initarg :content
+ :initform nil
+ :accessor content))
+ (:documentation ""))
+
+(defmethod initialize-instance :after ((home-service home-service) &key)
+ (setf (content home-service) (format nil "Welcome to the ~a website" (title *webapp*))))
+
+(defun home-json (&optional message errormsg)
+ (with-noauth (instance home-service)
+ (when message (setf (message instance) message))
+ (when errormsg (setf (errormsg instance) errormsg))))
diff --git a/lisp/service/inetorg-add-service.lisp b/lisp/service/inetorg-add-service.lisp
new file mode 100644
index 0000000..a58a10d
--- /dev/null
+++ b/lisp/service/inetorg-add-service.lisp
@@ -0,0 +1,55 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :ldapadmin)
+
+(defclass inetorg-add-service (auth-service)
+ ((form :initarg :form
+ :initform nil
+ :accessor form)
+ (title :initarg :title
+ :initform nil
+ :accessor title))
+ (:documentation ""))
+
+(defmethod initialize-instance :after ((inetorg-add-service inetorg-add-service) &key)
+ (setf (title inetorg-add-service) "Add InetOrg Entry")
+ (setf (form inetorg-add-service) (make-form "inetorg-add-form"
+ nil
+ t
+ '((:name "add-givenname" :label "givenName" :field-type "text" :required "required")
+ (:name "add-sn" :label "sn" :field-type "text" :required "required")
+ (: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-businesscategory" :label "businessCategory" :field-type "text")
+ (:label "Create InetOrg Entry" :field-type "button" :onclick "on_inetorg_add_submit_clicked()")))))
+
+(defun inetorg-add-json ()
+ (with-auth (instance inetorg-add-service)
+ t))
+
+(defclass inetorg-add-submit-service (auth-service)
+ ((location-p :initform nil))
+ (:documentation ""))
+
+(defun inetorg-add-submit-json (givenname sn mail postaladdress postalcode st l telephonenumber mobile businesscategory)
+ (with-auth (instance inetorg-add-submit-service)
+ (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
+ :businesscategory businesscategory)))
+ (add-ldap-user ldap-user ldap)
+ (setf (session-value :message) "InetOrg entry created successfully.")))))
diff --git a/lisp/service/inetorg-delete-service.lisp b/lisp/service/inetorg-delete-service.lisp
new file mode 100644
index 0000000..7c27480
--- /dev/null
+++ b/lisp/service/inetorg-delete-service.lisp
@@ -0,0 +1,26 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :ldapadmin)
+
+(defclass inetorg-delete-service (auth-service)
+ ((cn :initarg :cn
+ :initform nil
+ :accessor cn)
+ (location-p :initform nil))
+ (:documentation ""))
+
+(defun inetorg-delete-json (cn)
+ (with-auth (instance inetorg-delete-service)
+ (setf (cn instance) cn)))
+
+(defclass inetorg-delete-submit-service (auth-service)
+ ((location-p :initform nil))
+ (:documentation ""))
+
+(defun inetorg-delete-submit-json (cn)
+ (with-auth (instance inetorg-delete-submit-service)
+ (with-ldap (ldap)
+ (let ((ldap-user (get-ldap-user ldap cn)))
+ (delete-ldap-user ldap-user ldap)
+ (setf (session-value :message) "InetOrg entry deleted successfully.")))))
diff --git a/lisp/service/inetorg-modify-service.lisp b/lisp/service/inetorg-modify-service.lisp
new file mode 100644
index 0000000..89e5b9b
--- /dev/null
+++ b/lisp/service/inetorg-modify-service.lisp
@@ -0,0 +1,59 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :ldapadmin)
+
+(defclass inetorg-modify-service (auth-service)
+ ((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)
+ (location-p :initform nil))
+ (:documentation ""))
+
+(defmethod initialize-instance :after ((inetorg-modify-service inetorg-modify-service) &key)
+ (setf (form inetorg-modify-service) (make-form "inetorg-modify-form"
+ nil
+ t
+ `((: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-businesscategory" :label "businessCategory" :field-type "text")
+ (: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-service (auth-service)
+ ((location-p :initform nil))
+ (:documentation ""))
+
+(defun inetorg-modify-submit-json (givenname sn mail postaladdress postalcode st l telephonenumber mobile businesscategory)
+ (with-auth (instance inetorg-modify-submit-service)
+ (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
+ :businesscategory businesscategory)))
+ (modify-ldap-user ldap-user ldap)
+ (setf (session-value :message) "InetOrg entry saved successfully.")))))
diff --git a/lisp/service/inetorg-view-service.lisp b/lisp/service/inetorg-view-service.lisp
new file mode 100644
index 0000000..379b1b0
--- /dev/null
+++ b/lisp/service/inetorg-view-service.lisp
@@ -0,0 +1,70 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :ldapadmin)
+
+(defclass inetorg-view-service (auth-service)
+ ((title :initarg :title
+ :initform nil
+ :accessor title))
+ (:documentation ""))
+
+(defun inetorg-view-json (&optional message errormsg)
+ (with-auth (instance inetorg-view-service)
+ (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)
+ ((form :initarg :form
+ :initform nil
+ :accessor form)
+ (title :initarg :title
+ :initform nil
+ :accessor title)
+ (location-p :initform nil))
+ (:documentation ""))
+
+(defmethod initialize-instance :after ((inetorg-view-search-service inetorg-view-search-service) &key)
+ (setf (form inetorg-view-search-service) (make-form "inetorg-view-search-form"
+ nil
+ t
+ '((: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-businesscategory" :label "businessCategory" :field-type "text")
+ (:label "Search InetOrg Entries" :field-type "button" :onclick "on_inetorg_view_search_clicked()")))))
+
+(defun inetorg-view-search-json ()
+ (with-auth (instance inetorg-view-search-service)
+ nil))
+
+(defclass inetorg-view-results-service (auth-service)
+ ((results :initarg :results
+ :initform nil
+ :accessor results)
+ (location-p :initform nil))
+ (:documentation ""))
+
+(defun inetorg-view-results-json (givenname sn mail postaladdress postalcode st l telephonenumber mobile businesscategory)
+ (with-auth (instance inetorg-view-results-service)
+ (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)
+ (:businesscategory ,businesscategory)))
+ (lambda (x y) (string< (get-cn x) (get-cn y))))))))
diff --git a/lisp/service/login-service.lisp b/lisp/service/login-service.lisp
new file mode 100644
index 0000000..82b647c
--- /dev/null
+++ b/lisp/service/login-service.lisp
@@ -0,0 +1,43 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :ldapadmin)
+
+(defclass login-service (rest-service)
+ ((form :initarg :form
+ :initform nil
+ :accessor form)
+ (title :initarg :title
+ :initform nil
+ :accessor title))
+ (:documentation ""))
+
+(defmethod initialize-instance :after ((login-service login-service) &key)
+ (setf (title login-service) "Login")
+ (setf (form login-service) (make-form "login-form"
+ nil
+ t
+ '((:name "dn" :label "DN" :field-type "text" :required "required")
+ (:name "password" :label "Password" :field-type "password" :required "required")
+ (:label "Login" :field-type "button" :onclick "on_login_submit_clicked()")))))
+
+(defun login-json ()
+ (with-noauth (instance login-service)
+ t))
+
+(defclass login-authenticate-service (rest-service)
+ ((location-p :initform nil))
+ (:documentation ""))
+
+(defun login-authenticate-json (dn password)
+ (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/lisp/service/logout-service.lisp b/lisp/service/logout-service.lisp
new file mode 100644
index 0000000..59a9968
--- /dev/null
+++ b/lisp/service/logout-service.lisp
@@ -0,0 +1,14 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :ldapadmin)
+
+(defclass logout-service (rest-service)
+ ((location-p :initform nil))
+ (:documentation ""))
+
+(defun logout-json ()
+ (with-noauth (instance logout-service)
+ (setf (session-value :permissions) "anonymous")
+ (setf (location instance) "/home")
+ (setf (message instance) "You are now logged out.")))
diff --git a/lisp/service/menu-service.lisp b/lisp/service/menu-service.lisp
new file mode 100644
index 0000000..728b8e5
--- /dev/null
+++ b/lisp/service/menu-service.lisp
@@ -0,0 +1,55 @@
+;;; -*- 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" :handler "/home" :permissions "t")
+ (:id "a_menu_login" :label "Login" :handler "/login" :permissions "anonymous")
+ (:id "a_menu_logout" :label "Logout" :handler "/logout" :permissions "admin")
+ (:id "a_menu_inetorg_view" :label "View InetOrg Entries" :handler "/inetorg/view" :permissions "admin")
+ (:id "a_menu_inetorg_add" :label "Add InetOrg Entry" :handler "/inetorg/add" :permissions "admin")))
+
+(defclass menuitem ()
+ ((id :initarg :id
+ :initform nil
+ :accessor id)
+ (label :initarg :label
+ :initform nil
+ :accessor label)
+ (handler :initarg :handler
+ :initform nil
+ :accessor handler)
+ (permissions :initarg :permissions
+ :initform nil
+ :accessor permissions)
+ (children :initarg :children
+ :initform nil
+ :accessor children))
+ (:documentation ""))
+
+(defclass menu-service (base-service)
+ ((menuitems :initarg :menuitems
+ :initform nil
+ :accessor menuitems)
+ (location-p :initarg :location-p
+ :initform nil
+ :accessor location-p))
+ (:documentation ""))
+
+(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)
+ :handler (getf x :handler)))
+ (remove-if 'null (mapcar (lambda (x)
+ (when (find-if (lambda (y)
+ (string= (getf x :permissions) y))
+ `("t" ,(session-value :permissions)))
+ x))
+ *menu-config*)))))
+
+(defun menu-json ()
+ (with-noauth (instance menu-service)
+ t))
diff --git a/lisp/service/rest-service.lisp b/lisp/service/rest-service.lisp
new file mode 100644
index 0000000..ff66dd4
--- /dev/null
+++ b/lisp/service/rest-service.lisp
@@ -0,0 +1,36 @@
+;;; -*- 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)
+ (message :initarg :message
+ :initform nil
+ :accessor message)
+ (errormsg :initarg :errormsg
+ :initform nil
+ :accessor errormsg))
+ (:documentation ""))
+
+(defmethod initialize-instance :after ((rest-service rest-service) &key)
+ (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))
+
+(defun type-to-path (rest-type)
+ (concatenate 'string "/" (ppcre:regex-replace "-service" (string-downcase (type-of rest-type)) "/")))
generated by cgit v1.3 (git 2.53.0) at 2026-09-24 14:36:43 +0000