From 31657f6854edc116946a099be889440fb3e92e53 Mon Sep 17 00:00:00 2001 From: ckonstanski Date: Sat, 27 Nov 2021 10:20:12 -0700 Subject: moved everything under lisp/ --- service/auth-service.lisp | 30 ------------- service/base-service.lisp | 8 ---- service/generic-form.lisp | 87 ------------------------------------- service/home-service.lisp | 18 -------- service/inetorg-add-service.lisp | 55 ----------------------- service/inetorg-delete-service.lisp | 26 ----------- service/inetorg-modify-service.lisp | 59 ------------------------- service/inetorg-view-service.lisp | 70 ----------------------------- service/login-service.lisp | 43 ------------------ service/logout-service.lisp | 14 ------ service/menu-service.lisp | 55 ----------------------- service/rest-service.lisp | 36 --------------- 12 files changed, 501 deletions(-) delete mode 100644 service/auth-service.lisp delete mode 100644 service/base-service.lisp delete mode 100644 service/generic-form.lisp delete mode 100644 service/home-service.lisp delete mode 100644 service/inetorg-add-service.lisp delete mode 100644 service/inetorg-delete-service.lisp delete mode 100644 service/inetorg-modify-service.lisp delete mode 100644 service/inetorg-view-service.lisp delete mode 100644 service/login-service.lisp delete mode 100644 service/logout-service.lisp delete mode 100644 service/menu-service.lisp delete mode 100644 service/rest-service.lisp (limited to 'service') diff --git a/service/auth-service.lisp b/service/auth-service.lisp deleted file mode 100644 index 0a84264..0000000 --- a/service/auth-service.lisp +++ /dev/null @@ -1,30 +0,0 @@ -;;; -*- 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/service/base-service.lisp b/service/base-service.lisp deleted file mode 100644 index 7eb8fb3..0000000 --- a/service/base-service.lisp +++ /dev/null @@ -1,8 +0,0 @@ -;;; -*- 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 deleted file mode 100644 index 6e0c821..0000000 --- a/service/generic-form.lisp +++ /dev/null @@ -1,87 +0,0 @@ -;;; -*- 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/service/home-service.lisp b/service/home-service.lisp deleted file mode 100644 index b914cae..0000000 --- a/service/home-service.lisp +++ /dev/null @@ -1,18 +0,0 @@ -;;; -*- 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/service/inetorg-add-service.lisp b/service/inetorg-add-service.lisp deleted file mode 100644 index a58a10d..0000000 --- a/service/inetorg-add-service.lisp +++ /dev/null @@ -1,55 +0,0 @@ -;;; -*- 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/service/inetorg-delete-service.lisp b/service/inetorg-delete-service.lisp deleted file mode 100644 index 7c27480..0000000 --- a/service/inetorg-delete-service.lisp +++ /dev/null @@ -1,26 +0,0 @@ -;;; -*- 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/service/inetorg-modify-service.lisp b/service/inetorg-modify-service.lisp deleted file mode 100644 index 89e5b9b..0000000 --- a/service/inetorg-modify-service.lisp +++ /dev/null @@ -1,59 +0,0 @@ -;;; -*- 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/service/inetorg-view-service.lisp b/service/inetorg-view-service.lisp deleted file mode 100644 index 379b1b0..0000000 --- a/service/inetorg-view-service.lisp +++ /dev/null @@ -1,70 +0,0 @@ -;;; -*- 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/service/login-service.lisp b/service/login-service.lisp deleted file mode 100644 index 82b647c..0000000 --- a/service/login-service.lisp +++ /dev/null @@ -1,43 +0,0 @@ -;;; -*- 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/service/logout-service.lisp b/service/logout-service.lisp deleted file mode 100644 index 59a9968..0000000 --- a/service/logout-service.lisp +++ /dev/null @@ -1,14 +0,0 @@ -;;; -*- 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/service/menu-service.lisp b/service/menu-service.lisp deleted file mode 100644 index 728b8e5..0000000 --- a/service/menu-service.lisp +++ /dev/null @@ -1,55 +0,0 @@ -;;; -*- 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/service/rest-service.lisp b/service/rest-service.lisp deleted file mode 100644 index ff66dd4..0000000 --- a/service/rest-service.lisp +++ /dev/null @@ -1,36 +0,0 @@ -;;; -*- 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)) "/"))) -- cgit v1.3