Skip to content
Newer
Older
100644 267 lines (211 sloc) 8.72 KB
f3fa551 @nixeagle shadow defmethod
authored Jan 14, 2010
1 (in-package :cl-user)
2
c900e15 start off with what was in eighthbit-website
James S authored Jan 1, 2010
3 (defpackage #:nisp.ldap
15629e2 @nixeagle use nisp.util-types here
authored Jan 21, 2010
4 (:use :cl :iterate :nisp.util-types)
695e8d7 @nixeagle shadow delete and search and export my generic methods that might not be
authored Jan 12, 2010
5 (:shadow :delete :search)
f3fa551 @nixeagle shadow defmethod
authored Jan 14, 2010
6 (:shadowing-import-from :closer-mop
7 :defmethod)
1a07d66 add one-line-ldif
James S authored Jan 3, 2010
8 (:export :*connections* #:with-ldap #:get-single-entry
695e8d7 @nixeagle shadow delete and search and export my generic methods that might not be
authored Jan 12, 2010
9 #:one-line-ldif #:make-ldap #:describing-ldif-search
10
11 ;; Generics to add your own "hooks" onto. These are there
12 ;; for convience only, and likely will not exist in the same
13 ;; form 3 months from now as the way these are implemented is
14 ;; far from ideal. (These are done as around methods
15 ;; specializing on (T T), which means nobody else can write
16 ;; an around method to specialize on (T T). I'd vastly prefer
17 ;; adding another method selection :hook or similar.
18 #:compute-ldap #:compute-filter
9995f32 @nixeagle export dn, base, rdn
authored Jan 26, 2010
19
7cd1c3f @nixeagle export organizational unit
authored Jan 26, 2010
20 :dn :base :rdn :organizational-unit
695e8d7 @nixeagle shadow delete and search and export my generic methods that might not be
authored Jan 12, 2010
21 ))
c900e15 start off with what was in eighthbit-website
James S authored Jan 1, 2010
22
23 (in-package :nisp.ldap)
24
25
b72cbcf defparameter instead of defvar
James S authored Jan 3, 2010
26 (defvar *connections* '()
f27e4e7 add *connections* to hold a list of connections for 8b
James S authored Jan 2, 2010
27 "Property list of connections to LDAP.")
28
c900e15 start off with what was in eighthbit-website
James S authored Jan 1, 2010
29 ;;; Load an optional config file, the lack of this should not cause this
30 ;;; program to become unusable.
7b8e767 define 8b related ldap objects in their own file as well as get the
James S authored Jan 2, 2010
31
c0c9893 @nixeagle all entries where it makes sense to be part of an ldap entry subclass…
authored Jan 26, 2010
32 (defclass ldap-entry-mixin () ()
33 (:documentation "Entrys where it makes sense to translate to ldif or ~
34 trivial-ldap entries."))
35
176f1f9 @nixeagle add abstract-filter
authored Jan 13, 2010
36 (defclass abstract-filter ()
37 ()
38 ;; This feels right, but not positive how subclassing is going to work
39 ;; yet.
40 (:documentation "Base of all ldap filters."))
a99a82d add make-ldap, given a keyword or an ldap:ldap object, return an
James S authored Jan 2, 2010
41
6f1601d @nixeagle define a message class for ldap messages
authored Jan 13, 2010
42 (defclass message ()
43 ()
44 ;; I think this is what trivial-ldap is missing that does not feel
45 ;; "right". Messages are taken in as raw strings not as a CLOS class I
46 ;; can select on.
47 (:documentation "Base of all ldap messages."))
48
21b3d8f @nixeagle define 3 generic functions for modification objects
authored Jan 21, 2010
49 (defgeneric (setf modification-time) (object))
5252bea @nixeagle add modification-state setf specializer and modify the generic function
authored Jan 21, 2010
50 (defgeneric (setf modification-state) (state object))
21b3d8f @nixeagle define 3 generic functions for modification objects
authored Jan 21, 2010
51 (defgeneric (setf modification) (object))
07b75e2 @nixeagle new modification state class
authored Jan 21, 2010
52 (defclass modification-state ()
69db4e4 @nixeagle rename slot to modification state
authored Jan 21, 2010
53 ((modification-state :type boolean
54 :reader modification-state
55 :initform nil))
07b75e2 @nixeagle new modification state class
authored Jan 21, 2010
56 (:documentation "Represents a modified state."))
57
c5d65d1 @nixeagle update dn to remember its modification state
authored Jan 21, 2010
58 (defclass modification-time ()
9580acf @nixeagle add modified-time, change the reader method name.
authored Jan 21, 2010
59 ;; Not fully implemented yet. Just prototyping.
eb93223 @nixeagle rename slot to modification-time
authored Jan 21, 2010
60 ((modification-time :reader modification-time
61 :initform (get-universal-time)))
9580acf @nixeagle add modified-time, change the reader method name.
authored Jan 21, 2010
62 (:documentation "Represents time of last modification"))
63
e9e253c @nixeagle change super class order, time after state.
authored Jan 21, 2010
64 (defclass modification (modification-state modification-time)
aecaaf6 @nixeagle add class modification with two super classes, -state and -time.
authored Jan 21, 2010
65 ()
66 (:documentation "Represents objects that remember modification data."))
c5d65d1 @nixeagle update dn to remember its modification state
authored Jan 21, 2010
67
2496dda @nixeagle Add a specializer on (setf modification-time). This only allows modified
authored Jan 21, 2010
68 (defmethod (setf modification-time) ((object modification-time))
69 "Set the modification time of OBJECT to now."
70 ;; It makes no sense to allow any other value then "now" for modified
71 ;; time.
e47699c @nixeagle This was backwards, a modification time object cannot depend on the e…
authored Jan 21, 2010
72 (setf (slot-value object 'modification-time) (get-universal-time)))
bed1bcf @nixeagle two modificatio state specializers on modification-time class
authored Jan 21, 2010
73 (defmethod (setf modification-state) ((state (eql nil))
74 (object modification-time))
75 (declare (ignore state object)))
76 (defmethod (setf modification-state) ((state t)
77 (object modification-time))
9e2f12f @nixeagle declare state to be a boolean
authored Jan 21, 2010
78 (declare (type boolean state)
79 (ignore state))
201270b @nixeagle allow a next method to be called if one exists.
authored Jan 21, 2010
80 (if (next-method-p)
81 (values (setf (modification-time) object) (call-next-method))
82 (setf (modification-time) object)))
83
2496dda @nixeagle Add a specializer on (setf modification-time). This only allows modified
authored Jan 21, 2010
84
5252bea @nixeagle add modification-state setf specializer and modify the generic function
authored Jan 21, 2010
85 (defmethod (setf modification-state) ((state t)
86 (object modification-state))
87 "Set modification state of OBJECT to STATE."
88 ;; We allow setting to false here as it is a legit operation to do on
89 ;; discarding changes, saving changes and so on.
9e2f12f @nixeagle declare state to be a boolean
authored Jan 21, 2010
90 (declare (type boolean state))
062fab4 @nixeagle if there is another method, modification-state specializer will now r…
authored Jan 21, 2010
91 (setf (slot-value object 'modification-state) state)
92 (if (next-method-p)
93 (values state (call-next-method))
94 state))
5252bea @nixeagle add modification-state setf specializer and modify the generic function
authored Jan 21, 2010
95
70aedec @nixeagle modification-state setf specalizer defined for modification.
authored Jan 21, 2010
96 (defmethod (setf modification-state) ((state t) (object modification))
97 "Set both modification time and state of OBJECT."
9e2f12f @nixeagle declare state to be a boolean
authored Jan 21, 2010
98 (declare (type boolean state))
70aedec @nixeagle modification-state setf specalizer defined for modification.
authored Jan 21, 2010
99 (call-next-method))
5252bea @nixeagle add modification-state setf specializer and modify the generic function
authored Jan 21, 2010
100
381e7c8 @nixeagle reorder mixin class and defgeneric
authored Jan 22, 2010
101 (defclass base-mixin ()
102 ()
103 (:documentation "LDAP objects where the concept of `base' makes sense."))
104
105 (defclass rdn-mixin ()
106 ()
107 (:documentation "LDAP objects where `rdn' makes sense."))
108
9a85284 @nixeagle fix docstring for generic base object.
authored Jan 22, 2010
109 (defgeneric base (ldap-object)
110 (:documentation "Return the path to the LDAP-OBJECT.
87f00d7 @nixeagle define base generic method
authored Jan 22, 2010
111
5498e92 @nixeagle default methods on rdn-mixin and base-mixin both error
authored Jan 22, 2010
112 `base' in ldap speak is the same meaning as pwd in a shell.")
113 (:method ((ldap base-mixin))
114 (error "Redefine `base' on the subclass of base-mixin.")))
6fc4993 @nixeagle define base-mixin
authored Jan 22, 2010
115
e177703 @nixeagle add rdn-mixin class and rdn generic
authored Jan 22, 2010
116 (defgeneric rdn (ldap-object)
117 (:documentation "Return the rdn of the LDAP-OBJECT.
118
119 `rdn' is roughly equivalent to a filename in *nisp. They are unique to
5498e92 @nixeagle default methods on rdn-mixin and base-mixin both error
authored Jan 22, 2010
120 the `base' they are in.")
121 (:method ((ldap rdn-mixin))
122 (error "Redefine `rdn' on the subclass of rdn-mixin.")))
e177703 @nixeagle add rdn-mixin class and rdn generic
authored Jan 22, 2010
123
83441fa @nixeagle remove abstract-base, we can define base in terms of base only.
authored Jan 26, 2010
124 (defclass base (base-mixin)
125 ((base :type string
126 :initform (error "A LDAP object without a base makes no sense!")
e540129 @nixeagle add class base for ldap equivalent of `pwd'
authored Jan 22, 2010
127 :reader base
128 :initarg :base
129 :documentation "LDAP base path: equivalent to 'ls' on *nix."))
83441fa @nixeagle remove abstract-base, we can define base in terms of base only.
authored Jan 26, 2010
130 (:documentation "Represents LDAP base path."))
e540129 @nixeagle add class base for ldap equivalent of `pwd'
authored Jan 22, 2010
131
00653a1 @nixeagle abstract classes derive from respective mixin classes
authored Jan 22, 2010
132 (defclass abstract-rdn (rdn-mixin)
8b9f606 @nixeagle change type back to just string
authored Jan 22, 2010
133 ((rdn :type string
cf09ff7 @nixeagle defining rdn before dn, it makes logical sense
authored Jan 22, 2010
134 :reader rdn
135 :initarg :rdn))
136 (:documentation "!!!")
137 (:default-initargs :rdn ""))
138
a0db842 @nixeagle abstract methods for base and rdn
authored Jan 22, 2010
139 (defclass rdn (abstract-rdn modification)
140 ())
141
1319037 @nixeagle define rdn-key
authored Jan 26, 2010
142 (defclass rdn-key ()
143 ((rdn-key :initarg :rdn-key
144 :type string
145 :initform (error "rdn-key needs to be defaulted to a sensible value.")))
146 (:documentation "key value for a rdn field.
147
148 Objects inheriting this should default this to something sensible."))
b5cb032 @nixeagle dn now in terms of dn-mixin for inheriting rdn-mixin and base-mixin
authored Jan 22, 2010
149
150 (defclass dn (dn-mixin modification-state)
900a7ed @nixeagle redefine dn in terms of rdn-mixin and base-mixin
authored Jan 22, 2010
151 ((rdn :type rdn :initarg :rdn)
152 (base :type base :initarg :base))
153 (:documentation "LDAP Distinguished Name"))
f3fbbce @nixeagle Add 3 classes, entry, rdn, dn.
authored Jan 13, 2010
154
155
7cd1c3f @nixeagle export organizational unit
authored Jan 26, 2010
156 (defclass organizational-unit (dn ldap-entry-mixin)
157 ()
158 (:default-initargs :rdn-key "ou"))
159
a822eac @nixeagle move dn-mixin out of the way, probably won't be using it.
authored Jan 26, 2010
160 (defclass dn-mixin (rdn-mixin base-mixin) ())
161
162
7cd1c3f @nixeagle export organizational unit
authored Jan 26, 2010
163
f3fbbce @nixeagle Add 3 classes, entry, rdn, dn.
authored Jan 13, 2010
164 (defclass entry (trivial-ldap:entry)
165 ((dn :type dn
166 :initarg :dn)
167 (rdn :type rdn
5498e92 @nixeagle default methods on rdn-mixin and base-mixin both error
authored Jan 22, 2010
168 :initarg :rdn))
00f7d91 @nixeagle subclass trivial-ldap:entry for method combination purposes
authored Jan 13, 2010
169 (:documentation "Basic LDAP entry.
170
171 Mostly used for method selection apart from trivial-ldap."))
172
f3fbbce @nixeagle Add 3 classes, entry, rdn, dn.
authored Jan 13, 2010
173
a99a82d add make-ldap, given a keyword or an ldap:ldap object, return an
James S authored Jan 2, 2010
174 (defun make-ldap (ldap-or-keyword
175 &optional (connections *connections*))
176 "Return an LDAP object, so long as input is an ldap object or a
177 keyword referincing an ldap object."
178 (if (typep ldap-or-keyword 'ldap:ldap)
179 ldap-or-keyword
180 (getf connections ldap-or-keyword)))
181
ab17ba9 move 8b stuff to its own package
James S authored Jan 2, 2010
182
c900e15 start off with what was in eighthbit-website
James S authored Jan 1, 2010
183
abb5d46 fix up with-ldap to make use of make-ldap
James S authored Jan 2, 2010
184 (defmacro with-ldap (ldap-or-keyword &body body)
c900e15 start off with what was in eighthbit-website
James S authored Jan 1, 2010
185 "Execute BODY in the context of LDAP bound to the ldap server."
abb5d46 fix up with-ldap to make use of make-ldap
James S authored Jan 2, 2010
186 ;; I think this is fine to do instead of using gensyms. I'll consult
187 ;; on lisp on this later.
188 (let ((ldap (gensym)))
189 `(let ((,ldap (make-ldap ,ldap-or-keyword)))
190 (prog2
191 (ldap:bind ,ldap)
192 (progn ,@body)
193 (ldap:unbind ,ldap)))))
c900e15 start off with what was in eighthbit-website
James S authored Jan 1, 2010
194
0a1202a add describing-ldif-search
James S authored Jan 3, 2010
195 (defun describing-ldif-search (search-string &optional (ldap :anon))
196 "Development helper that prints a description of all search matches to
197 standard output in ldif form."
6797e72 @nixeagle fix search to use my list results rather then dosearch macro.
authored Jan 12, 2010
198 (mapc #'(lambda (x)
199 (princ (ldap:ldif x)))
200 (list-search-results search-string (make-ldap ldap))))
0a1202a add describing-ldif-search
James S authored Jan 3, 2010
201
202
be45e0b @nixeagle Fix a few problems with the conversion to iterate. There is still an …
authored Jan 21, 2010
203 (defun strip-newlines (string &optional (replace-char #\Space))
c900e15 start off with what was in eighthbit-website
James S authored Jan 1, 2010
204 "Given a string, remove all newlines.
205
206 This is very irc specific where lines need to be all on one line.
207
208 Note that the newline is not replaced by a space!"
be45e0b @nixeagle Fix a few problems with the conversion to iterate. There is still an …
authored Jan 21, 2010
209 (iter (for char :in-string string)
210 (collect (if (char= char #\Newline)
211 replace-char
212 char) :result-type string)))
c900e15 start off with what was in eighthbit-website
James S authored Jan 1, 2010
213
775ace2 split print-single-entry up so we have get-single-entry
James S authored Jan 2, 2010
214 (defun get-single-entry (search-string &key (ldap :anon)
215 attrs)
216 "Get a single trivial-ldap:entry object by binding and searching."
217 (with-ldap ldap
218 (ldap:search (make-ldap ldap) search-string
219 :attributes attrs)
220 (ldap:next-search-result (make-ldap ldap))))
221
1a07d66 add one-line-ldif
James S authored Jan 3, 2010
222 (defgeneric one-line-ldif (entry)
223 (:documentation "ldif on one line.")
224 (:method ((entry ldap:entry))
225 (strip-newlines (ldap:ldif entry) #\ )))
226
02adada we should also default to the keyword :anon
James S authored Jan 2, 2010
227 (defun print-single-entry (search-string &key (ldap :anon)
c900e15 start off with what was in eighthbit-website
James S authored Jan 1, 2010
228 attrs)
229 (strip-newlines
230 (ldap:ldif
959fa93 lets use make-ldap to ensure we pass an ldap object.
James S authored Jan 2, 2010
231 (get-single-entry search-string :ldap (make-ldap ldap) :attrs attrs))
c900e15 start off with what was in eighthbit-website
James S authored Jan 1, 2010
232 #\ ))
233
0d967e1 @nixeagle add and use list-all-pending
authored Jan 26, 2010
234 (defun list-all-pending (&optional (ldap :anon))
235 "Dump all pending results on LDAP."
236 (iter (repeat 1000000)
237 (until (not (ldap:results-pending-p ldap)))
238 (collect (ldap:next-search-result ldap))))
239
ab17ba9 move 8b stuff to its own package
James S authored Jan 2, 2010
240 (defun list-search-results (search-string &optional (ldap :anon))
c900e15 start off with what was in eighthbit-website
James S authored Jan 1, 2010
241 "List of entries from a search."
2b80476 @nixeagle make sure we have an ldap object
authored Jan 12, 2010
242 (let ((ldap (make-ldap ldap)))
243 (with-ldap ldap
244 (ldap:search ldap search-string)
0d967e1 @nixeagle add and use list-all-pending
authored Jan 26, 2010
245 (list-all-pending ldap))))
52cc8c0 @nixeagle (compute-filter): Calculate the string to search by given arguments
authored Jan 12, 2010
246
247 (defgeneric compute-filter (type &rest args)
248 (:documentation "Compute an LDAP filter to do searches with.")
249 (:method (type &key)
250 "Return TYPE unchanged ignoring ARGS."
251 type))
252
253 (defmethod compute-filter ((filter (eql :all)) &key)
254 "Matches all objects."
255f095 @nixeagle (compute-ldap): Create or select an LDAP object.
authored Jan 12, 2010
255 "(objectClass=*)")
256
257 (defgeneric compute-ldap (ldap &rest args)
258 (:documentation "Make or select LDAP.")
259 (:method (ldap &rest args)
260 (declare (ignore args))
261 "Return LDAP ignoring ARGS."
95350db @nixeagle (trivial-ldap:search): Add around method to check arguments for sensi…
authored Jan 12, 2010
262 ldap))
263
264 (defmethod trivial-ldap:search :around ((ldap t) (filter t) &key)
265 "Search LDAP for all records under specified base."
266 (call-next-method (compute-ldap ldap) (compute-filter filter)))
Something went wrong with that request. Please try again.