diff options
Diffstat (limited to 'entity')
| -rw-r--r-- | entity/entity.lisp | 44 | ||||
| -rw-r--r-- | entity/generics.lisp | 35 | ||||
| -rw-r--r-- | entity/ldap-user.lisp | 75 |
3 files changed, 0 insertions, 154 deletions
diff --git a/entity/entity.lisp b/entity/entity.lisp deleted file mode 100644 index ea665e2..0000000 --- a/entity/entity.lisp +++ /dev/null @@ -1,44 +0,0 @@ -;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- -(declaim (optimize (speed 0) (safety 3) (debug 3))) - -(in-package :ldapadmin) - -(defclass entity () - () - (:documentation "Superclass for all entity objects. An entity object -is one that represents a single tuple from a data source, like a SQL -table or LDAP record. In this case we're dealing with LDAP records.")) - -(defmacro with-entity-slots-to-list ((entity slot) &body body) - "Iterates over all the slots of `entity' and builds an alist based -on those slots. `slot' is the iterator." - `(remove-if #'null (mapcar (lambda (slot) - (when (slot-is-field-p slot) - ,@body)) - (org-ckons-core::map-slot-names ,entity)))) - -(defmethod attribute-value-list ((entity entity) &optional (keep-nulls nil)) - (with-entity-slots-to-list (entity slot) - (when (or keep-nulls - (and (not keep-nulls) - (not (org-ckons-core::null-or-empty-p (slot-value entity slot))))) - `(,slot . ,(slot-value entity slot))))) - -(defmethod get-slots-regex ((entity entity) regex) - (sort (remove-if-not (lambda (x) (org-ckons-core::match-it regex (symbol-name x))) - (org-ckons-core::map-slot-names entity)) - (lambda (x y) (string< (symbol-name x) (symbol-name y))))) - -(defmethod intersect-slots ((entity entity) slots) - (let ((intersect-slots ())) - (loop for class-slot in (org-ckons-core::map-slot-names entity) do - (let ((class-slot-string (org-ckons-core::parse-symbol class-slot))) - (loop for arg-slot in slots do - (let ((arg-slot-string (org-ckons-core::parse-symbol arg-slot))) - (when (string-equal class-slot-string arg-slot-string) - (push class-slot intersect-slots)))))) - (nreverse intersect-slots))) - -(defun slot-is-field-p (slot) - (let ((name (symbol-name slot))) - (and (equal name (ppcre:regex-replace "^\\*" name ""))))) diff --git a/entity/generics.lisp b/entity/generics.lisp deleted file mode 100644 index 510c7db..0000000 --- a/entity/generics.lisp +++ /dev/null @@ -1,35 +0,0 @@ -;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- -(declaim (optimize (speed 0) (safety 3) (debug 3))) - -(in-package :ldapadmin) - -(defgeneric attribute-value-list (entity &optional keep-nulls) - (:documentation "Builds an alist of attribute/value pairs.")) - -(defgeneric get-slots-regex (entity regex) - (:documentation "Gets an alphabetically sorted list of `entity' -slots whose names match `regex'.")) - -(defgeneric intersect-slots (entity slots) - (:documentation "Since the built-in `intersect' function does not -take package name prefixes into account, and since -`org-ckons-core::map-slot-names' returns slot names prefixed with the -package name, this method was written to intersect lists ignoring -package prefixes.")) - -(defgeneric get-cn (ldap-user) - (:documentation "Generates the CN of an `ldap-user'. `trivial-ldap' -does not fetch `cn' so we have to assemble it ourselves.")) - -(defgeneric get-user-dn (ldap-user ldap) - (:documentation "Generates the full DN of an `ldap-user'.")) - -(defgeneric modify-ldap-user (ldap-user ldap) - (:documentation "Writes the data in `ldap-user' to the LDAP -server.")) - -(defgeneric delete-ldap-user (ldap-user ldap) - (:documentation "Deletes an `ldap-user' from LDAP.")) - -(defgeneric add-ldap-user (ldap-user ldap) - (:documentation "Adds an `ldap-user' to LDAP.")) diff --git a/entity/ldap-user.lisp b/entity/ldap-user.lisp deleted file mode 100644 index 282592b..0000000 --- a/entity/ldap-user.lisp +++ /dev/null @@ -1,75 +0,0 @@ -;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- -(declaim (optimize (speed 0) (safety 3) (debug 3))) - -(in-package :ldapadmin) - -(defclass ldap-user (entity) - ((givenname :initarg :givenname - :initform nil - :accessor givenname) - (sn :initarg :sn - :initform nil - :accessor sn) - (mail :initarg :mail - :initform nil - :accessor mail) - (postaladdress :initarg :postaladdress - :initform nil - :accessor postaladdress) - (postalcode :initarg :postalcode - :initform nil - :accessor postalcode) - (st :initarg :st - :initform nil - :accessor st) - (l :initarg :l - :initform nil - :accessor l) - (telephonenumber :initarg :telephonenumber - :initform nil - :accessor telephonenumber) - (mobile :initarg :mobile - :initform nil - :accessor mobile) - (businesscategory :initarg :businesscategory - :initform nil - :accessor businesscategory)) - (:documentation "A single inetOrgPerson entry from LDAP.")) - -(defmethod get-cn ((ldap-user ldap-user)) - (format nil "~a ~a" (givenname ldap-user) (sn ldap-user))) - -(defmethod get-user-dn ((ldap-user ldap-user) (ldap ldap)) - (format nil "cn=~a ~a,ou=people,~a" (givenname ldap-user) (sn ldap-user) (base-dn ldap))) - -(defmethod modify-ldap-user ((ldap-user ldap-user) (ldap ldap)) - (let* ((existing-user (get-ldap-user ldap (get-cn ldap-user))) - (existing-attrs (attribute-value-list existing-user t)) - (new-attrs (attribute-value-list ldap-user)) - (ldap-entry (ldap:new-entry (get-user-dn ldap-user ldap) :attrs existing-attrs)) - (change-attrs (remove-if #'null - (mapcar (lambda (attr) - (let ((new-attr (assoc (car attr) new-attrs))) - (cond ((and (org-ckons-core::null-or-empty-p (cdr attr)) - (not (org-ckons-core::null-or-empty-p (cdr new-attr)))) - `(ldap:add ,(car attr) ,(cdr new-attr))) - ((and (not (org-ckons-core::null-or-empty-p (cdr attr))) - (org-ckons-core::null-or-empty-p (cdr new-attr))) - `(ldap:delete ,(car attr) ,(cdr attr))) - ((and (not (org-ckons-core::null-or-empty-p (cdr attr))) - (not (org-ckons-core::null-or-empty-p (cdr new-attr))) - (not (string= (cdr attr) (cdr new-attr)))) - `(ldap:replace ,(car attr) ,(cdr new-attr)))))) - existing-attrs)))) - (ldap:modify (connection ldap) (get-user-dn ldap-user ldap) change-attrs))) - -(defmethod delete-ldap-user ((ldap-user ldap-user) (ldap ldap)) - (let* ((existing-user (get-ldap-user ldap (get-cn ldap-user))) - (existing-attrs (attribute-value-list existing-user)) - (ldap-entry (ldap:new-entry (get-user-dn ldap-user ldap) :attrs existing-attrs))) - (ldap:delete ldap-entry (connection ldap)))) - -(defmethod add-ldap-user ((ldap-user ldap-user) (ldap ldap)) - (let* ((new-attrs (attribute-value-list ldap-user)) - (new-entry (ldap:new-entry (get-user-dn ldap-user ldap) :attrs (org-ckons-core::add-to-list new-attrs '((objectclass . (inetorgperson))))))) - (ldap:add new-entry (connection ldap)))) |