Skip to content

HTTPS clone URL

Subversion checkout URL

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