Mercurial > hg > xemacs-beta
annotate lisp/ldap.el @ 5882:bbe4146603db
Reduce regexp usage, now CL-oriented non-regexp code available, core Lisp
lisp/ChangeLog addition:
2015-04-01 Aidan Kehoe <kehoea@parhasard.net>
When calling #'string-match with a REGEXP without regular
expression special characters, call #'search, #'mismatch, #'find,
etc. instead, making our code less likely to side-effect other
functions' match data and a little faster.
* apropos.el (apropos-command):
* apropos.el (apropos):
Call (position ?\n ...) rather than (string-match "\n" ...) here.
* buff-menu.el:
* buff-menu.el (buffers-menu-omit-invisible-buffers):
Don't fire up the regexp engine just to check if a string starts
with a space.
* buff-menu.el (select-buffers-tab-buffers-by-mode):
Don't fire up the regexp engine just to compare mode basenames.
* buff-menu.el (format-buffers-tab-line):
* buff-menu.el (build-buffers-tab-internal): Moved to being a
label within the following.
* buff-menu.el (buffers-tab-items): Use the label.
* bytecomp.el (byte-compile-log-1):
Don't fire up the regexp engine just to look for a newline.
* cus-edit.el (get):
Ditto.
* cus-edit.el (custom-variable-value-create):
Ditto, but for a colon.
* descr-text.el (describe-text-sexp):
Ditto.
* descr-text.el (describe-char-unicode-data):
Use #'split-string-by-char given that we're just looking for a
semicolon.
* descr-text.el (describe-char):
Don't fire up the regexp engine just to look for a newline.
* disass.el (disassemble-internal):
Ditto.
* files.el (file-name-sans-extension):
Implement this using #'position.
* files.el (file-name-extension):
Correct this function's docstring, implement it in terms of
#'position.
* files.el (insert-directory):
Don't fire up the regexp engine to split a string by space; don't
reverse the list of switches, this is actually a longstand bug as
far as I can see.
* gnuserv.el (gnuserv-process-filter):
Use #'position here, instead of consing inside #'split-string
needlessly.
* gtk-file-dialog.el (gtk-file-dialog-update-dropdown):
Use #'split-string-by-char here, don't fire up #'split-string for
directory-sep-char.
* gtk-font-menu.el (hack-font-truename):
Implement this more cheaply in terms of #'find,
#'split-string-by-char, #'equal, rather than #'string-match,
#'split-string, #'string-equal.
* hyper-apropos.el (hyper-apropos-grok-functions):
* hyper-apropos.el (hyper-apropos-grok-variables):
Look for a newline using #'position rather than #'string-match in
these functions.
* info.el (Info-insert-dir):
* info.el (Info-insert-file-contents):
* info.el (Info-follow-reference):
* info.el (Info-extract-menu-node-name):
* info.el (Info-menu):
Look for fixed strings using #'position or #'search as appropriate
in this file.
* ldap.el (ldap-decode-string):
* ldap.el (ldap-encode-string):
#'encode-coding-string, #'decode-coding-string are always
available, don't check if they're fboundp.
* ldap.el (ldap-decode-address):
* ldap.el (ldap-encode-address):
Use #'split-string-by-char in these functions.
* lisp-mnt.el (lm-creation-date):
* lisp-mnt.el (lm-last-modified-date):
Don't fire up the regexp engine just to look for spaces in this file.
* menubar-items.el (default-menubar):
Use (not (mismatch ...)) rather than #'string-match here, for
simple regexp.
Use (search "beta" ...) rather than (string-match "beta" ...)
* menubar-items.el (sort-buffers-menu-alphabetically):
* menubar-items.el (sort-buffers-menu-by-mode-then-alphabetically):
* menubar-items.el (group-buffers-menu-by-mode-then-alphabetically):
Don't fire up the regexp engine to check if a string starts with
a space or an asterisk.
Use the more fine-grained results of #'compare-strings; compare
case-insensitively for the buffer menu.
* menubar-items.el (list-all-buffers):
* menubar-items.el (tutorials-menu-filter):
Use #'equal rather than #'string-equal, which, in this context,
has the drawback of not having a bytecode, and no redeeming
features.
* minibuf.el:
* minibuf.el (un-substitute-in-file-name):
Use #'count, rather than counting the occurences of $ using the
regexp engine.
* minibuf.el (read-file-name-internal-1):
Don't fire up the regexp engine to search for ?=.
* mouse.el (mouse-eval-sexp):
Check for newline with #'find.
* msw-font-menu.el (mswindows-reset-device-font-menus):
Split a string by newline with #'split-string-by-char.
* mule/japanese.el:
* mule/japanese.el ("Japanese"):
Use #'search rather than #'string-match; canoncase before
comparing; fix a bug I had introduced where I had been making case
insensitive comparisons where the case mattered.
* mule/korea-util.el (default-korean-keyboard):
Look for ?3 using #'find, not #'string-march.
* mule/korea-util.el (quail-hangul-switch-hanja):
Search for a fixed string using #'search.
* mule/mule-cmds.el (set-locale-for-language-environment):
#'position, #'substitute rather than #'string-match,
#'replace-in-string.
* newcomment.el (comment-make-extra-lines):
Use #'search rather than #'string-match for a simple string.
* package-get.el (package-get-remote-filename):
Use #'position when looking for ?@
* process.el (setenv):
* process.el (read-envvar-name):
Use #'position when looking for ?=.
* replace.el (map-query-replace-regexp):
Use #'split-string-by-char instead of using an inline
implementation of it.
* select.el (select-convert-from-cf-text):
* select.el (select-convert-from-cf-unicodetext):
Use #'position rather than #'string-match in these functions.
* setup-paths.el (paths-emacs-data-root-p):
Use #'search when looking for simple string.
* sound.el (load-sound-file):
Use #'split-string-by-char rather than an inline reimplementation
of same.
* startup.el (splash-screen-window-body):
* startup.el (splash-screen-tty-body):
Search for simple strings using #'search.
* version.el (emacs-version):
Ditto.
* x-font-menu.el (hack-font-truename):
Implement this more cheaply in terms of #'find,
#'split-string-by-char, #'equal, rather than #'string-match,
#'split-string, #'string-equal.
* x-font-menu.el (x-reset-device-font-menus-core):
Use #'split-string-by-char here.
* x-init.el (x-initialize-keyboard):
Search for a simple string using #'search.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Wed, 01 Apr 2015 14:28:20 +0100 |
parents | ac37a5f7e5be |
children |
rev | line source |
---|---|
428 | 1 ;;; ldap.el --- LDAP support for Emacs |
2 | |
3 ;; Copyright (C) 1997 Free Software Foundation, Inc. | |
4 | |
5 ;; Author: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> | |
6 ;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> | |
7 ;; Created: Jan 1998 | |
502 | 8 ;; Version: $Revision: 1.12 $ |
428 | 9 ;; Keywords: help comm |
10 | |
11 ;; This file is part of XEmacs | |
12 | |
5404
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
4783
diff
changeset
|
13 ;; XEmacs is free software: you can redistribute it and/or modify it |
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
4783
diff
changeset
|
14 ;; under the terms of the GNU General Public License as published by the |
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
4783
diff
changeset
|
15 ;; Free Software Foundation, either version 3 of the License, or (at your |
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
4783
diff
changeset
|
16 ;; option) any later version. |
428 | 17 |
5404
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
4783
diff
changeset
|
18 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
4783
diff
changeset
|
19 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
4783
diff
changeset
|
20 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
4783
diff
changeset
|
21 ;; for more details. |
428 | 22 |
23 ;; You should have received a copy of the GNU General Public License | |
5404
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
4783
diff
changeset
|
24 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
428 | 25 |
26 ;;; Commentary: | |
27 ;; This file provides mid-level and user-level functions to access directory | |
444 | 28 ;; servers using the LDAP protocol (RFC 1777). |
428 | 29 |
30 ;;; Installation: | |
31 ;; LDAP support must have been built into XEmacs. | |
32 | |
33 | |
34 ;;; Code: | |
35 | |
502 | 36 (globally-declare-fboundp '(ldapp ldap-open ldap-close ldap-add ldap-modify |
37 ldap-delete)) | |
38 | |
442 | 39 (eval-when '(load) |
40 (if (not (fboundp 'ldap-open)) | |
41 (error "No LDAP support compiled in this XEmacs"))) | |
42 | |
428 | 43 (defgroup ldap nil |
44 "Lightweight Directory Access Protocol" | |
45 :group 'comm) | |
46 | |
47 (defcustom ldap-default-host nil | |
48 "*Default LDAP server hostname. | |
444 | 49 A TCP port number can be appended to that name using a colon as |
428 | 50 a separator." |
51 :type '(choice (string :tag "Host name") | |
52 (const :tag "Use library default" nil)) | |
53 :group 'ldap) | |
54 | |
55 (defcustom ldap-default-port nil | |
56 "*Default TCP port for LDAP connections. | |
57 Initialized from the LDAP library at build time. Default value is 389." | |
58 :type '(choice (const :tag "Use library default" nil) | |
59 (integer :tag "Port number")) | |
60 :group 'ldap) | |
61 | |
62 (defcustom ldap-default-base nil | |
63 "*Default base for LDAP searches. | |
64 This is a string using the syntax of RFC 1779. | |
65 For instance, \"o=ACME, c=US\" limits the search to the | |
66 Acme organization in the United States." | |
67 :type '(choice (const :tag "Use library default" nil) | |
68 (string :tag "Search base")) | |
69 :group 'ldap) | |
70 | |
71 | |
72 (defcustom ldap-host-parameters-alist nil | |
73 "*Alist of host-specific options for LDAP transactions. | |
74 The format of each list element is: | |
75 \(HOST PROP1 VAL1 PROP2 VAL2 ...) | |
76 HOST is the hostname of an LDAP server (with an optional TCP port number | |
444 | 77 appended to it using a colon as a separator). |
428 | 78 PROPn and VALn are property/value pairs describing parameters for the server. |
79 Valid properties include: | |
444 | 80 `binddn' is the distinguished name of the user to bind as |
428 | 81 (in RFC 1779 syntax). |
82 `passwd' is the password to use for simple authentication. | |
444 | 83 `auth' is the authentication method to use. |
428 | 84 Possible values are: `simple', `krbv41' and `krbv42'. |
85 `base' is the base for the search as described in RFC 1779. | |
86 `scope' is one of the three symbols `subtree', `base' or `onelevel'. | |
87 `deref' is one of the symbols `never', `always', `search' or `find'. | |
88 `timelimit' is the timeout limit for the connection in seconds. | |
89 `sizelimit' is the maximum number of matches to return." | |
90 :type '(repeat :menu-tag "Host parameters" | |
91 :tag "Host parameters" | |
92 (list :menu-tag "Host parameters" | |
93 :tag "Host parameters" | |
94 :value nil | |
95 (string :tag "Host name") | |
96 (checklist :inline t | |
97 :greedy t | |
98 (list | |
444 | 99 :tag "Search Base" |
428 | 100 :inline t |
101 (const :tag "Search Base" base) | |
102 string) | |
103 (list | |
104 :tag "Binding DN" | |
105 :inline t | |
106 (const :tag "Binding DN" binddn) | |
107 string) | |
108 (list | |
109 :tag "Password" | |
110 :inline t | |
111 (const :tag "Password" passwd) | |
112 string) | |
113 (list | |
114 :tag "Authentication Method" | |
115 :inline t | |
116 (const :tag "Authentication Method" auth) | |
117 (choice | |
118 (const :menu-tag "None" :tag "None" nil) | |
119 (const :menu-tag "Simple" :tag "Simple" simple) | |
120 (const :menu-tag "Kerberos 4.1" :tag "Kerberos 4.1" krbv41) | |
121 (const :menu-tag "Kerberos 4.2" :tag "Kerberos 4.2" krbv42))) | |
122 (list | |
444 | 123 :tag "Search Scope" |
428 | 124 :inline t |
125 (const :tag "Search Scope" scope) | |
126 (choice | |
127 (const :menu-tag "Default" :tag "Default" nil) | |
128 (const :menu-tag "Subtree" :tag "Subtree" subtree) | |
129 (const :menu-tag "Base" :tag "Base" base) | |
130 (const :menu-tag "One Level" :tag "One Level" onelevel))) | |
131 (list | |
132 :tag "Dereferencing" | |
133 :inline t | |
134 (const :tag "Dereferencing" deref) | |
135 (choice | |
136 (const :menu-tag "Default" :tag "Default" nil) | |
137 (const :menu-tag "Never" :tag "Never" never) | |
138 (const :menu-tag "Always" :tag "Always" always) | |
139 (const :menu-tag "When searching" :tag "When searching" search) | |
140 (const :menu-tag "When locating base" :tag "When locating base" find))) | |
141 (list | |
142 :tag "Time Limit" | |
143 :inline t | |
144 (const :tag "Time Limit" timelimit) | |
145 (integer :tag "(in seconds)")) | |
146 (list | |
147 :tag "Size Limit" | |
148 :inline t | |
149 (const :tag "Size Limit" sizelimit) | |
150 (integer :tag "(number of records)"))))) | |
151 :group 'ldap) | |
152 | |
442 | 153 (defcustom ldap-verbose nil |
154 "*If non-nil, LDAP operations echo progress messages." | |
155 :type 'boolean | |
156 :group 'ldap) | |
157 | |
428 | 158 (defcustom ldap-ignore-attribute-codings nil |
159 "*If non-nil, do not perform any encoding/decoding on LDAP attribute values." | |
160 :type 'boolean | |
161 :group 'ldap) | |
162 | |
163 (defcustom ldap-default-attribute-decoder nil | |
164 "*Decoder function to use for attributes whose syntax is unknown." | |
165 :type 'symbol | |
166 :group 'ldap) | |
167 | |
168 (defcustom ldap-coding-system nil | |
169 "*Coding system of LDAP string values. | |
444 | 170 LDAP v3 specifies the coding system of strings to be UTF-8. |
428 | 171 Mule support is needed for this." |
172 :type 'symbol | |
173 :group 'ldap) | |
174 | |
175 (defvar ldap-attribute-syntax-encoders | |
444 | 176 [nil ; 1 ACI Item N |
177 nil ; 2 Access Point Y | |
178 nil ; 3 Attribute Type Description Y | |
179 nil ; 4 Audio N | |
180 nil ; 5 Binary N | |
181 nil ; 6 Bit String Y | |
182 ldap-encode-boolean ; 7 Boolean Y | |
183 nil ; 8 Certificate N | |
184 nil ; 9 Certificate List N | |
185 nil ; 10 Certificate Pair N | |
186 ldap-encode-country-string ; 11 Country String Y | |
187 ldap-encode-string ; 12 DN Y | |
188 nil ; 13 Data Quality Syntax Y | |
189 nil ; 14 Delivery Method Y | |
190 ldap-encode-string ; 15 Directory String Y | |
191 nil ; 16 DIT Content Rule Description Y | |
192 nil ; 17 DIT Structure Rule Description Y | |
193 nil ; 18 DL Submit Permission Y | |
194 nil ; 19 DSA Quality Syntax Y | |
195 nil ; 20 DSE Type Y | |
196 nil ; 21 Enhanced Guide Y | |
197 nil ; 22 Facsimile Telephone Number Y | |
198 nil ; 23 Fax N | |
199 nil ; 24 Generalized Time Y | |
200 nil ; 25 Guide Y | |
201 nil ; 26 IA5 String Y | |
202 number-to-string ; 27 INTEGER Y | |
203 nil ; 28 JPEG N | |
204 nil ; 29 Master And Shadow Access Points Y | |
205 nil ; 30 Matching Rule Description Y | |
206 nil ; 31 Matching Rule Use Description Y | |
207 nil ; 32 Mail Preference Y | |
208 nil ; 33 MHS OR Address Y | |
209 nil ; 34 Name And Optional UID Y | |
210 nil ; 35 Name Form Description Y | |
211 nil ; 36 Numeric String Y | |
212 nil ; 37 Object Class Description Y | |
213 nil ; 38 OID Y | |
214 nil ; 39 Other Mailbox Y | |
215 nil ; 40 Octet String Y | |
216 ldap-encode-address ; 41 Postal Address Y | |
217 nil ; 42 Protocol Information Y | |
218 nil ; 43 Presentation Address Y | |
219 ldap-encode-string ; 44 Printable String Y | |
220 nil ; 45 Subtree Specification Y | |
221 nil ; 46 Supplier Information Y | |
222 nil ; 47 Supplier Or Consumer Y | |
223 nil ; 48 Supplier And Consumer Y | |
224 nil ; 49 Supported Algorithm N | |
225 nil ; 50 Telephone Number Y | |
226 nil ; 51 Teletex Terminal Identifier Y | |
227 nil ; 52 Telex Number Y | |
228 nil ; 53 UTC Time Y | |
229 nil ; 54 LDAP Syntax Description Y | |
230 nil ; 55 Modify Rights Y | |
231 nil ; 56 LDAP Schema Definition Y | |
232 nil ; 57 LDAP Schema Description Y | |
233 nil ; 58 Substring Assertion Y | |
234 ] | |
428 | 235 "A vector of functions used to encode LDAP attribute values. |
236 The sequence of functions corresponds to the sequence of LDAP attribute syntax | |
444 | 237 object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in |
428 | 238 RFC2252 section 4.3.2") |
239 | |
240 (defvar ldap-attribute-syntax-decoders | |
444 | 241 [nil ; 1 ACI Item N |
242 nil ; 2 Access Point Y | |
243 nil ; 3 Attribute Type Description Y | |
244 nil ; 4 Audio N | |
245 nil ; 5 Binary N | |
246 nil ; 6 Bit String Y | |
247 ldap-decode-boolean ; 7 Boolean Y | |
248 nil ; 8 Certificate N | |
249 nil ; 9 Certificate List N | |
250 nil ; 10 Certificate Pair N | |
251 ldap-decode-string ; 11 Country String Y | |
252 ldap-decode-string ; 12 DN Y | |
253 nil ; 13 Data Quality Syntax Y | |
254 nil ; 14 Delivery Method Y | |
255 ldap-decode-string ; 15 Directory String Y | |
256 nil ; 16 DIT Content Rule Description Y | |
257 nil ; 17 DIT Structure Rule Description Y | |
258 nil ; 18 DL Submit Permission Y | |
259 nil ; 19 DSA Quality Syntax Y | |
260 nil ; 20 DSE Type Y | |
261 nil ; 21 Enhanced Guide Y | |
262 nil ; 22 Facsimile Telephone Number Y | |
263 nil ; 23 Fax N | |
264 nil ; 24 Generalized Time Y | |
265 nil ; 25 Guide Y | |
266 nil ; 26 IA5 String Y | |
267 string-to-number ; 27 INTEGER Y | |
268 nil ; 28 JPEG N | |
269 nil ; 29 Master And Shadow Access Points Y | |
270 nil ; 30 Matching Rule Description Y | |
271 nil ; 31 Matching Rule Use Description Y | |
272 nil ; 32 Mail Preference Y | |
273 nil ; 33 MHS OR Address Y | |
274 nil ; 34 Name And Optional UID Y | |
275 nil ; 35 Name Form Description Y | |
276 nil ; 36 Numeric String Y | |
277 nil ; 37 Object Class Description Y | |
278 nil ; 38 OID Y | |
279 nil ; 39 Other Mailbox Y | |
280 nil ; 40 Octet String Y | |
281 ldap-decode-address ; 41 Postal Address Y | |
282 nil ; 42 Protocol Information Y | |
283 nil ; 43 Presentation Address Y | |
284 ldap-decode-string ; 44 Printable String Y | |
285 nil ; 45 Subtree Specification Y | |
286 nil ; 46 Supplier Information Y | |
287 nil ; 47 Supplier Or Consumer Y | |
288 nil ; 48 Supplier And Consumer Y | |
289 nil ; 49 Supported Algorithm N | |
290 nil ; 50 Telephone Number Y | |
291 nil ; 51 Teletex Terminal Identifier Y | |
292 nil ; 52 Telex Number Y | |
293 nil ; 53 UTC Time Y | |
294 nil ; 54 LDAP Syntax Description Y | |
295 nil ; 55 Modify Rights Y | |
296 nil ; 56 LDAP Schema Definition Y | |
297 nil ; 57 LDAP Schema Description Y | |
298 nil ; 58 Substring Assertion Y | |
299 ] | |
428 | 300 "A vector of functions used to decode LDAP attribute values. |
301 The sequence of functions corresponds to the sequence of LDAP attribute syntax | |
444 | 302 object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in |
428 | 303 RFC2252 section 4.3.2") |
304 | |
305 | |
306 (defvar ldap-attribute-syntaxes-alist | |
307 '((createtimestamp . 24) | |
308 (modifytimestamp . 24) | |
309 (creatorsname . 12) | |
310 (modifiersname . 12) | |
311 (subschemasubentry . 12) | |
312 (attributetypes . 3) | |
313 (objectclasses . 37) | |
314 (matchingrules . 30) | |
315 (matchingruleuse . 31) | |
316 (namingcontexts . 12) | |
317 (altserver . 26) | |
318 (supportedextension . 38) | |
319 (supportedcontrol . 38) | |
320 (supportedsaslmechanisms . 15) | |
321 (supportedldapversion . 27) | |
322 (ldapsyntaxes . 16) | |
323 (ditstructurerules . 17) | |
324 (nameforms . 35) | |
325 (ditcontentrules . 16) | |
326 (objectclass . 38) | |
327 (aliasedobjectname . 12) | |
328 (cn . 15) | |
329 (sn . 15) | |
330 (serialnumber . 44) | |
331 (c . 15) | |
332 (l . 15) | |
333 (st . 15) | |
334 (street . 15) | |
335 (o . 15) | |
336 (ou . 15) | |
337 (title . 15) | |
338 (description . 15) | |
339 (searchguide . 25) | |
340 (businesscategory . 15) | |
341 (postaladdress . 41) | |
342 (postalcode . 15) | |
343 (postofficebox . 15) | |
344 (physicaldeliveryofficename . 15) | |
345 (telephonenumber . 50) | |
346 (telexnumber . 52) | |
347 (telexterminalidentifier . 51) | |
348 (facsimiletelephonenumber . 22) | |
349 (x121address . 36) | |
350 (internationalisdnnumber . 36) | |
351 (registeredaddress . 41) | |
352 (destinationindicator . 44) | |
353 (preferreddeliverymethod . 14) | |
354 (presentationaddress . 43) | |
355 (supportedapplicationcontext . 38) | |
356 (member . 12) | |
357 (owner . 12) | |
358 (roleoccupant . 12) | |
359 (seealso . 12) | |
360 (userpassword . 40) | |
361 (usercertificate . 8) | |
362 (cacertificate . 8) | |
363 (authorityrevocationlist . 9) | |
364 (certificaterevocationlist . 9) | |
365 (crosscertificatepair . 10) | |
366 (name . 15) | |
367 (givenname . 15) | |
368 (initials . 15) | |
369 (generationqualifier . 15) | |
370 (x500uniqueidentifier . 6) | |
371 (dnqualifier . 44) | |
372 (enhancedsearchguide . 21) | |
373 (protocolinformation . 42) | |
374 (distinguishedname . 12) | |
375 (uniquemember . 34) | |
376 (houseidentifier . 15) | |
377 (supportedalgorithms . 49) | |
378 (deltarevocationlist . 9) | |
379 (dmdname . 15)) | |
380 "A map of LDAP attribute names to their type object id minor number. | |
381 This table is built from RFC2252 Section 5 and RFC2256 Section 5") | |
382 | |
383 | |
384 ;; Coding/decoding functions | |
385 | |
386 (defun ldap-encode-boolean (bool) | |
387 (if bool | |
388 "TRUE" | |
389 "FALSE")) | |
390 | |
391 (defun ldap-decode-boolean (str) | |
392 (cond | |
393 ((string-equal str "TRUE") | |
394 t) | |
395 ((string-equal str "FALSE") | |
396 nil) | |
397 (t | |
398 (error "Wrong LDAP boolean string: %s" str)))) | |
444 | 399 |
428 | 400 (defun ldap-encode-country-string (str) |
401 ;; We should do something useful here... | |
5366
f00192e1cd49
Examining the result of #'length: `eql', not `=', it's better style & cheaper
Aidan Kehoe <kehoea@parhasard.net>
parents:
4783
diff
changeset
|
402 (if (not (eql 2 (length str))) |
428 | 403 (error "Invalid country string: %s" str))) |
404 | |
405 (defun ldap-decode-string (str) | |
5882
bbe4146603db
Reduce regexp usage, now CL-oriented non-regexp code available, core Lisp
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
406 (decode-coding-string str ldap-coding-system)) |
428 | 407 |
408 (defun ldap-encode-string (str) | |
5882
bbe4146603db
Reduce regexp usage, now CL-oriented non-regexp code available, core Lisp
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
409 (encode-coding-string str ldap-coding-system)) |
428 | 410 |
411 (defun ldap-decode-address (str) | |
5882
bbe4146603db
Reduce regexp usage, now CL-oriented non-regexp code available, core Lisp
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
412 (mapconcat 'ldap-decode-string (split-string-by-char str ?$) "\n")) |
428 | 413 |
414 (defun ldap-encode-address (str) | |
5882
bbe4146603db
Reduce regexp usage, now CL-oriented non-regexp code available, core Lisp
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
415 (mapconcat 'ldap-encode-string (split-string-by-char str ?\n) "$")) |
428 | 416 |
417 ;; LDAP protocol functions | |
444 | 418 |
428 | 419 (defun ldap-get-host-parameter (host parameter) |
420 "Get the value of PARAMETER for HOST in `ldap-host-parameters-alist'." | |
421 (plist-get (cdr (assoc host ldap-host-parameters-alist)) | |
422 parameter)) | |
444 | 423 |
428 | 424 (defun ldap-decode-attribute (attr) |
425 "Decode the attribute/value pair ATTR according to LDAP rules. | |
444 | 426 The attribute name is looked up in `ldap-attribute-syntaxes-alist' |
427 and the corresponding decoder is then retrieved from | |
428 | 428 `ldap-attribute-syntax-decoders' and applied on the value(s)." |
429 (let* ((name (car attr)) | |
430 (values (cdr attr)) | |
431 (syntax-id (cdr (assq (intern (downcase name)) | |
432 ldap-attribute-syntaxes-alist))) | |
433 decoder) | |
434 (if syntax-id | |
435 (setq decoder (aref ldap-attribute-syntax-decoders | |
436 (1- syntax-id))) | |
437 (setq decoder ldap-default-attribute-decoder)) | |
438 (if decoder | |
439 (cons name (mapcar decoder values)) | |
440 attr))) | |
441 | |
442 | 442 (defun ldap-decode-entry (entry) |
443 "Decode the attributes of ENTRY according to LDAP rules." | |
444 (let (dn decoded) | |
445 (setq dn (car entry)) | |
446 (if (stringp dn) | |
447 (setq entry (cdr entry)) | |
448 (setq dn nil)) | |
449 (setq decoded (mapcar 'ldap-decode-attribute entry)) | |
450 (if dn | |
451 (cons dn decoded) | |
452 decoded))) | |
453 | |
454 (defun ldap-search (arg1 &rest args) | |
444 | 455 "Perform an LDAP search." |
442 | 456 (apply (if (ldapp arg1) |
457 'ldap-search-basic | |
458 'ldap-search-entries) arg1 args)) | |
459 | |
444 | 460 (make-obsolete 'ldap-search |
461 "Use `ldap-search-entries' instead or | |
442 | 462 `ldap-search-basic' for the low-level search API.") |
463 | |
464 (defun ldap-search-entries (filter &optional host attributes attrsonly withdn) | |
428 | 465 "Perform an LDAP search. |
466 FILTER is the search filter in RFC1558 syntax, i.e., something that | |
467 looks like \"(cn=John Smith)\". | |
468 HOST is the LDAP host on which to perform the search. | |
469 ATTRIBUTES is a list of attributes to retrieve; nil means retrieve all. | |
470 If ATTRSONLY is non nil, the attributes will be retrieved without | |
471 the associated values. | |
472 If WITHDN is non-nil each entry in the result will be prepennded with | |
473 its distinguished name DN. | |
444 | 474 Additional search parameters can be specified through |
428 | 475 `ldap-host-parameters-alist' which see. |
476 The function returns a list of matching entries. Each entry is itself | |
477 an alist of attribute/value pairs optionally preceded by the DN of the | |
478 entry according to the value of WITHDN." | |
479 (interactive "sFilter:") | |
480 (or host | |
481 (setq host ldap-default-host) | |
482 (error "No LDAP host specified")) | |
483 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) | |
484 ldap | |
485 result) | |
442 | 486 (if ldap-verbose |
487 (message "Opening LDAP connection to %s..." host)) | |
428 | 488 (setq ldap (ldap-open host host-plist)) |
442 | 489 (if ldap-verbose |
490 (message "Searching with LDAP on %s..." host)) | |
444 | 491 (setq result (ldap-search ldap filter |
442 | 492 (plist-get host-plist 'base) |
493 (plist-get host-plist 'scope) | |
494 attributes attrsonly withdn | |
495 ldap-verbose)) | |
428 | 496 (ldap-close ldap) |
497 (if ldap-ignore-attribute-codings | |
498 result | |
442 | 499 (mapcar 'ldap-decode-entry result)))) |
500 | |
501 (defun ldap-add-entries (entries &optional host binddn passwd) | |
502 "Add entries to an LDAP directory. | |
444 | 503 ENTRIES is a list of entry specifications of |
442 | 504 the form (DN (ATTR . VALUE) (ATTR . VALUE) ...) where |
505 DN is the distinguished name of an entry to add, the following | |
506 are cons cells containing attribute/value string pairs. | |
444 | 507 HOST is the LDAP host, defaulting to `ldap-default-host'. |
508 BINDDN is the DN to bind as to the server. | |
509 PASSWD is the corresponding password." | |
442 | 510 (or host |
511 (setq host ldap-default-host) | |
512 (error "No LDAP host specified")) | |
513 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) | |
514 ldap | |
515 (i 1)) | |
516 (if (or binddn passwd) | |
517 (setq host-plist (copy-seq host-plist))) | |
518 (if binddn | |
519 (setq host-plist (plist-put host-plist 'binddn binddn))) | |
520 (if passwd | |
521 (setq host-plist (plist-put host-plist 'passwd passwd))) | |
522 (if ldap-verbose | |
523 (message "Opening LDAP connection to %s..." host)) | |
524 (setq ldap (ldap-open host host-plist)) | |
525 (if ldap-verbose | |
526 (message "Adding LDAP entries...")) | |
4783
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
527 (mapc (function |
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
528 (lambda (thisentry) |
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
529 (ldap-add ldap (car thisentry) (cdr thisentry)) |
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
530 (if ldap-verbose |
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
531 (message "%d added" i)) |
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
532 (setq i (1+ i)))) |
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
533 entries) |
442 | 534 (ldap-close ldap))) |
535 | |
536 | |
537 (defun ldap-modify-entries (entry-mods &optional host binddn passwd) | |
538 "Modify entries of an LDAP directory. | |
444 | 539 ENTRY_MODS is a list of entry modifications of the form |
540 (DN MOD-SPEC1 MOD-SPEC2 ...) where DN is the distinguished name of | |
541 the entry to modify, the following are modification specifications. | |
542 A modification specification is itself a list of the form | |
4783
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
543 \(MOD-OP ATTR VALUE1 VALUE2 ...) MOD-OP and ATTR are mandatory, |
442 | 544 VALUEs are optional depending on MOD-OP. |
545 MOD-OP is the type of modification, one of the symbols `add', `delete' | |
546 or `replace'. ATTR is the LDAP attribute type to modify. | |
444 | 547 HOST is the LDAP host, defaulting to `ldap-default-host'. |
548 BINDDN is the DN to bind as to the server. | |
549 PASSWD is the corresponding password." | |
442 | 550 (or host |
551 (setq host ldap-default-host) | |
552 (error "No LDAP host specified")) | |
553 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) | |
554 ldap | |
555 (i 1)) | |
556 (if (or binddn passwd) | |
557 (setq host-plist (copy-seq host-plist))) | |
558 (if binddn | |
559 (setq host-plist (plist-put host-plist 'binddn binddn))) | |
560 (if passwd | |
561 (setq host-plist (plist-put host-plist 'passwd passwd))) | |
562 (if ldap-verbose | |
563 (message "Opening LDAP connection to %s..." host)) | |
564 (setq ldap (ldap-open host host-plist)) | |
565 (if ldap-verbose | |
566 (message "Modifying LDAP entries...")) | |
4783
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
567 (mapc (function |
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
568 (lambda (thisentry) |
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
569 (ldap-modify ldap (car thisentry) (cdr thisentry)) |
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
570 (if ldap-verbose |
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
571 (message "%d modified" i)) |
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
572 (setq i (1+ i)))) |
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
573 entry-mods) |
442 | 574 (ldap-close ldap))) |
575 | |
576 | |
577 (defun ldap-delete-entries (dn &optional host binddn passwd) | |
578 "Delete an entry from an LDAP directory. | |
444 | 579 DN is the distinguished name of an entry to delete or |
442 | 580 a list of those. |
444 | 581 HOST is the LDAP host, defaulting to `ldap-default-host'. |
582 BINDDN is the DN to bind as to the server. | |
442 | 583 PASSWD is the corresponding password." |
584 (or host | |
585 (setq host ldap-default-host) | |
586 (error "No LDAP host specified")) | |
587 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) | |
588 ldap) | |
589 (if (or binddn passwd) | |
590 (setq host-plist (copy-seq host-plist))) | |
591 (if binddn | |
592 (setq host-plist (plist-put host-plist 'binddn binddn))) | |
593 (if passwd | |
594 (setq host-plist (plist-put host-plist 'passwd passwd))) | |
595 (if ldap-verbose | |
596 (message "Opening LDAP connection to %s..." host)) | |
597 (setq ldap (ldap-open host host-plist)) | |
598 (if (consp dn) | |
599 (let ((i 1)) | |
600 (if ldap-verbose | |
601 (message "Deleting LDAP entries...")) | |
4783
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
602 (mapc (function |
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
603 (lambda (thisdn) |
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
604 (ldap-delete ldap thisdn) |
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
605 (if ldap-verbose |
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
606 (message "%d deleted" i)) |
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
607 (setq i (1+ i)))) |
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
608 dn)) |
442 | 609 (if ldap-verbose |
610 (message "Deleting LDAP entry...")) | |
611 (ldap-delete ldap dn)) | |
612 (ldap-close ldap))) | |
613 | |
428 | 614 |
615 (provide 'ldap) | |
444 | 616 |
428 | 617 ;;; ldap.el ends here |