Mercurial > hg > xemacs-beta
annotate lisp/ldap.el @ 5753:dbd8305e13cb
Warn about non-string non-integer ARG to #'gensym, bytecomp.el.
lisp/ChangeLog addition:
2013-08-21 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el:
* bytecomp.el (gensym):
* bytecomp.el (byte-compile-gensym): New.
Warn that gensym called in a for-effect context is unlikely to be
useful.
Warn about non-string non-integer ARGs, this is incorrect.
Am not changing the function to error with same, most code that
makes the mistake is has no problems, which is why it has survived
so long.
* window-xemacs.el (save-window-excursion/mapping):
* window.el (save-window-excursion):
Call #'gensym with a string, not a symbol.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Wed, 21 Aug 2013 19:02:59 +0100 |
| parents | ac37a5f7e5be |
| children | bbe4146603db |
| 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) | |
| 406 (if (fboundp 'decode-coding-string) | |
| 407 (decode-coding-string str ldap-coding-system))) | |
| 408 | |
| 409 (defun ldap-encode-string (str) | |
| 410 (if (fboundp 'encode-coding-string) | |
| 411 (encode-coding-string str ldap-coding-system))) | |
| 412 | |
| 413 (defun ldap-decode-address (str) | |
| 414 (mapconcat 'ldap-decode-string | |
| 415 (split-string str "\\$") | |
| 416 "\n")) | |
| 417 | |
| 418 (defun ldap-encode-address (str) | |
| 419 (mapconcat 'ldap-encode-string | |
| 420 (split-string str "\n") | |
| 421 "$")) | |
| 422 | |
| 423 | |
| 424 ;; LDAP protocol functions | |
| 444 | 425 |
| 428 | 426 (defun ldap-get-host-parameter (host parameter) |
| 427 "Get the value of PARAMETER for HOST in `ldap-host-parameters-alist'." | |
| 428 (plist-get (cdr (assoc host ldap-host-parameters-alist)) | |
| 429 parameter)) | |
| 444 | 430 |
| 428 | 431 (defun ldap-decode-attribute (attr) |
| 432 "Decode the attribute/value pair ATTR according to LDAP rules. | |
| 444 | 433 The attribute name is looked up in `ldap-attribute-syntaxes-alist' |
| 434 and the corresponding decoder is then retrieved from | |
| 428 | 435 `ldap-attribute-syntax-decoders' and applied on the value(s)." |
| 436 (let* ((name (car attr)) | |
| 437 (values (cdr attr)) | |
| 438 (syntax-id (cdr (assq (intern (downcase name)) | |
| 439 ldap-attribute-syntaxes-alist))) | |
| 440 decoder) | |
| 441 (if syntax-id | |
| 442 (setq decoder (aref ldap-attribute-syntax-decoders | |
| 443 (1- syntax-id))) | |
| 444 (setq decoder ldap-default-attribute-decoder)) | |
| 445 (if decoder | |
| 446 (cons name (mapcar decoder values)) | |
| 447 attr))) | |
| 448 | |
| 442 | 449 (defun ldap-decode-entry (entry) |
| 450 "Decode the attributes of ENTRY according to LDAP rules." | |
| 451 (let (dn decoded) | |
| 452 (setq dn (car entry)) | |
| 453 (if (stringp dn) | |
| 454 (setq entry (cdr entry)) | |
| 455 (setq dn nil)) | |
| 456 (setq decoded (mapcar 'ldap-decode-attribute entry)) | |
| 457 (if dn | |
| 458 (cons dn decoded) | |
| 459 decoded))) | |
| 460 | |
| 461 (defun ldap-search (arg1 &rest args) | |
| 444 | 462 "Perform an LDAP search." |
| 442 | 463 (apply (if (ldapp arg1) |
| 464 'ldap-search-basic | |
| 465 'ldap-search-entries) arg1 args)) | |
| 466 | |
| 444 | 467 (make-obsolete 'ldap-search |
| 468 "Use `ldap-search-entries' instead or | |
| 442 | 469 `ldap-search-basic' for the low-level search API.") |
| 470 | |
| 471 (defun ldap-search-entries (filter &optional host attributes attrsonly withdn) | |
| 428 | 472 "Perform an LDAP search. |
| 473 FILTER is the search filter in RFC1558 syntax, i.e., something that | |
| 474 looks like \"(cn=John Smith)\". | |
| 475 HOST is the LDAP host on which to perform the search. | |
| 476 ATTRIBUTES is a list of attributes to retrieve; nil means retrieve all. | |
| 477 If ATTRSONLY is non nil, the attributes will be retrieved without | |
| 478 the associated values. | |
| 479 If WITHDN is non-nil each entry in the result will be prepennded with | |
| 480 its distinguished name DN. | |
| 444 | 481 Additional search parameters can be specified through |
| 428 | 482 `ldap-host-parameters-alist' which see. |
| 483 The function returns a list of matching entries. Each entry is itself | |
| 484 an alist of attribute/value pairs optionally preceded by the DN of the | |
| 485 entry according to the value of WITHDN." | |
| 486 (interactive "sFilter:") | |
| 487 (or host | |
| 488 (setq host ldap-default-host) | |
| 489 (error "No LDAP host specified")) | |
| 490 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) | |
| 491 ldap | |
| 492 result) | |
| 442 | 493 (if ldap-verbose |
| 494 (message "Opening LDAP connection to %s..." host)) | |
| 428 | 495 (setq ldap (ldap-open host host-plist)) |
| 442 | 496 (if ldap-verbose |
| 497 (message "Searching with LDAP on %s..." host)) | |
| 444 | 498 (setq result (ldap-search ldap filter |
| 442 | 499 (plist-get host-plist 'base) |
| 500 (plist-get host-plist 'scope) | |
| 501 attributes attrsonly withdn | |
| 502 ldap-verbose)) | |
| 428 | 503 (ldap-close ldap) |
| 504 (if ldap-ignore-attribute-codings | |
| 505 result | |
| 442 | 506 (mapcar 'ldap-decode-entry result)))) |
| 507 | |
| 508 (defun ldap-add-entries (entries &optional host binddn passwd) | |
| 509 "Add entries to an LDAP directory. | |
| 444 | 510 ENTRIES is a list of entry specifications of |
| 442 | 511 the form (DN (ATTR . VALUE) (ATTR . VALUE) ...) where |
| 512 DN is the distinguished name of an entry to add, the following | |
| 513 are cons cells containing attribute/value string pairs. | |
| 444 | 514 HOST is the LDAP host, defaulting to `ldap-default-host'. |
| 515 BINDDN is the DN to bind as to the server. | |
| 516 PASSWD is the corresponding password." | |
| 442 | 517 (or host |
| 518 (setq host ldap-default-host) | |
| 519 (error "No LDAP host specified")) | |
| 520 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) | |
| 521 ldap | |
| 522 (i 1)) | |
| 523 (if (or binddn passwd) | |
| 524 (setq host-plist (copy-seq host-plist))) | |
| 525 (if binddn | |
| 526 (setq host-plist (plist-put host-plist 'binddn binddn))) | |
| 527 (if passwd | |
| 528 (setq host-plist (plist-put host-plist 'passwd passwd))) | |
| 529 (if ldap-verbose | |
| 530 (message "Opening LDAP connection to %s..." host)) | |
| 531 (setq ldap (ldap-open host host-plist)) | |
| 532 (if ldap-verbose | |
| 533 (message "Adding LDAP entries...")) | |
|
4783
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
534 (mapc (function |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
535 (lambda (thisentry) |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
536 (ldap-add ldap (car thisentry) (cdr thisentry)) |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
537 (if ldap-verbose |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
538 (message "%d added" i)) |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
539 (setq i (1+ i)))) |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
540 entries) |
| 442 | 541 (ldap-close ldap))) |
| 542 | |
| 543 | |
| 544 (defun ldap-modify-entries (entry-mods &optional host binddn passwd) | |
| 545 "Modify entries of an LDAP directory. | |
| 444 | 546 ENTRY_MODS is a list of entry modifications of the form |
| 547 (DN MOD-SPEC1 MOD-SPEC2 ...) where DN is the distinguished name of | |
| 548 the entry to modify, the following are modification specifications. | |
| 549 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
|
550 \(MOD-OP ATTR VALUE1 VALUE2 ...) MOD-OP and ATTR are mandatory, |
| 442 | 551 VALUEs are optional depending on MOD-OP. |
| 552 MOD-OP is the type of modification, one of the symbols `add', `delete' | |
| 553 or `replace'. ATTR is the LDAP attribute type to modify. | |
| 444 | 554 HOST is the LDAP host, defaulting to `ldap-default-host'. |
| 555 BINDDN is the DN to bind as to the server. | |
| 556 PASSWD is the corresponding password." | |
| 442 | 557 (or host |
| 558 (setq host ldap-default-host) | |
| 559 (error "No LDAP host specified")) | |
| 560 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) | |
| 561 ldap | |
| 562 (i 1)) | |
| 563 (if (or binddn passwd) | |
| 564 (setq host-plist (copy-seq host-plist))) | |
| 565 (if binddn | |
| 566 (setq host-plist (plist-put host-plist 'binddn binddn))) | |
| 567 (if passwd | |
| 568 (setq host-plist (plist-put host-plist 'passwd passwd))) | |
| 569 (if ldap-verbose | |
| 570 (message "Opening LDAP connection to %s..." host)) | |
| 571 (setq ldap (ldap-open host host-plist)) | |
| 572 (if ldap-verbose | |
| 573 (message "Modifying LDAP entries...")) | |
|
4783
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
574 (mapc (function |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
575 (lambda (thisentry) |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
576 (ldap-modify ldap (car thisentry) (cdr thisentry)) |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
577 (if ldap-verbose |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
578 (message "%d modified" i)) |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
579 (setq i (1+ i)))) |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
580 entry-mods) |
| 442 | 581 (ldap-close ldap))) |
| 582 | |
| 583 | |
| 584 (defun ldap-delete-entries (dn &optional host binddn passwd) | |
| 585 "Delete an entry from an LDAP directory. | |
| 444 | 586 DN is the distinguished name of an entry to delete or |
| 442 | 587 a list of those. |
| 444 | 588 HOST is the LDAP host, defaulting to `ldap-default-host'. |
| 589 BINDDN is the DN to bind as to the server. | |
| 442 | 590 PASSWD is the corresponding password." |
| 591 (or host | |
| 592 (setq host ldap-default-host) | |
| 593 (error "No LDAP host specified")) | |
| 594 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) | |
| 595 ldap) | |
| 596 (if (or binddn passwd) | |
| 597 (setq host-plist (copy-seq host-plist))) | |
| 598 (if binddn | |
| 599 (setq host-plist (plist-put host-plist 'binddn binddn))) | |
| 600 (if passwd | |
| 601 (setq host-plist (plist-put host-plist 'passwd passwd))) | |
| 602 (if ldap-verbose | |
| 603 (message "Opening LDAP connection to %s..." host)) | |
| 604 (setq ldap (ldap-open host host-plist)) | |
| 605 (if (consp dn) | |
| 606 (let ((i 1)) | |
| 607 (if ldap-verbose | |
| 608 (message "Deleting LDAP entries...")) | |
|
4783
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
609 (mapc (function |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
610 (lambda (thisdn) |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
611 (ldap-delete ldap thisdn) |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
612 (if ldap-verbose |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
613 (message "%d deleted" i)) |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
614 (setq i (1+ i)))) |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
615 dn)) |
| 442 | 616 (if ldap-verbose |
| 617 (message "Deleting LDAP entry...")) | |
| 618 (ldap-delete ldap dn)) | |
| 619 (ldap-close ldap))) | |
| 620 | |
| 428 | 621 |
| 622 (provide 'ldap) | |
| 444 | 623 |
| 428 | 624 ;;; ldap.el ends here |