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