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/ --- entity/ldap-user.lisp | 75 --------------------------------------------------- 1 file changed, 75 deletions(-) delete mode 100644 entity/ldap-user.lisp (limited to 'entity/ldap-user.lisp') 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)))) -- cgit v1.3