1;;; ldap.el --- client interface to LDAP for Emacs 2 3;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Oscar Figueiredo <oscar@cpe.fr> 7;; Maintainer: FSF 8;; Created: April 1998 9;; Keywords: comm 10 11;; This file is part of GNU Emacs. 12 13;; GNU Emacs is free software; you can redistribute it and/or modify 14;; it 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;; GNU Emacs is distributed in the hope that it will be useful, 19;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21;; GNU General Public License for more details. 22 23;; You should have received a copy of the GNU General Public License 24;; along with GNU Emacs; see the file COPYING. If not, write to the 25;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 26;; Boston, MA 02110-1301, USA. 27 28;;; Commentary: 29 30;; This package provides basic functionality to perform searches on LDAP 31;; servers. It requires a command line utility generally named 32;; `ldapsearch' to actually perform the searches. That program can be 33;; found in all LDAP developer kits such as: 34;; - UM-LDAP 3.3 (http://www.umich.edu/~dirsvcs/ldap/) 35;; - OpenLDAP (http://www.openldap.org/) 36 37;;; Code: 38 39(require 'custom) 40(eval-when-compile (require 'cl)) 41 42(defgroup ldap nil 43 "Lightweight Directory Access Protocol." 44 :version "21.1" 45 :group 'comm) 46 47(defcustom ldap-default-host nil 48 "*Default LDAP server. 49A TCP port number can be appended to that name using a colon as 50a 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. 57Initialized 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. 64This is a string using the syntax of RFC 1779. 65For instance, \"o=ACME, c=US\" limits the search to the 66Acme 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. 74The format of each list element is (HOST PROP1 VAL1 PROP2 VAL2 ...). 75HOST is the hostname of an LDAP server (with an optional TCP port number 76appended to it using a colon as a separator). 77PROPn and VALn are property/value pairs describing parameters for the server. 78Valid properties include: 79 `binddn' is the distinguished name of the user to bind as 80 (in RFC 1779 syntax). 81 `passwd' is the password to use for simple authentication. 82 `auth' is the authentication method to use. 83 Possible values are: `simple', `krbv41' and `krbv42'. 84 `base' is the base for the search as described in RFC 1779. 85 `scope' is one of the three symbols `subtree', `base' or `onelevel'. 86 `deref' is one of the symbols `never', `always', `search' or `find'. 87 `timelimit' is the timeout limit for the connection in seconds. 88 `sizelimit' is the maximum number of matches to return." 89 :type '(repeat :menu-tag "Host parameters" 90 :tag "Host parameters" 91 (list :menu-tag "Host parameters" 92 :tag "Host parameters" 93 :value nil 94 (string :tag "Host name") 95 (checklist :inline t 96 :greedy t 97 (list 98 :tag "Search Base" 99 :inline t 100 (const :tag "Search Base" base) 101 string) 102 (list 103 :tag "Binding DN" 104 :inline t 105 (const :tag "Binding DN" binddn) 106 string) 107 (list 108 :tag "Password" 109 :inline t 110 (const :tag "Password" passwd) 111 string) 112 (list 113 :tag "Authentication Method" 114 :inline t 115 (const :tag "Authentication Method" auth) 116 (choice 117 (const :menu-tag "None" :tag "None" nil) 118 (const :menu-tag "Simple" :tag "Simple" simple) 119 (const :menu-tag "Kerberos 4.1" :tag "Kerberos 4.1" krbv41) 120 (const :menu-tag "Kerberos 4.2" :tag "Kerberos 4.2" krbv42))) 121 (list 122 :tag "Search Scope" 123 :inline t 124 (const :tag "Search Scope" scope) 125 (choice 126 (const :menu-tag "Default" :tag "Default" nil) 127 (const :menu-tag "Subtree" :tag "Subtree" subtree) 128 (const :menu-tag "Base" :tag "Base" base) 129 (const :menu-tag "One Level" :tag "One Level" onelevel))) 130 (list 131 :tag "Dereferencing" 132 :inline t 133 (const :tag "Dereferencing" deref) 134 (choice 135 (const :menu-tag "Default" :tag "Default" nil) 136 (const :menu-tag "Never" :tag "Never" never) 137 (const :menu-tag "Always" :tag "Always" always) 138 (const :menu-tag "When searching" :tag "When searching" search) 139 (const :menu-tag "When locating base" :tag "When locating base" find))) 140 (list 141 :tag "Time Limit" 142 :inline t 143 (const :tag "Time Limit" timelimit) 144 (integer :tag "(in seconds)")) 145 (list 146 :tag "Size Limit" 147 :inline t 148 (const :tag "Size Limit" sizelimit) 149 (integer :tag "(number of records)"))))) 150 :group 'ldap) 151 152(defcustom ldap-ldapsearch-prog "ldapsearch" 153 "*The name of the ldapsearch command line program." 154 :type '(string :tag "`ldapsearch' Program") 155 :group 'ldap) 156 157(defcustom ldap-ldapsearch-args '("-LL" "-tt") 158 "*A list of additional arguments to pass to `ldapsearch'." 159 :type '(repeat :tag "`ldapsearch' Arguments" 160 (string :tag "Argument")) 161 :group 'ldap) 162 163(defcustom ldap-ignore-attribute-codings nil 164 "*If non-nil, do not encode/decode LDAP attribute values." 165 :type 'boolean 166 :group 'ldap) 167 168(defcustom ldap-default-attribute-decoder nil 169 "*Decoder function to use for attributes whose syntax is unknown." 170 :type 'symbol 171 :group 'ldap) 172 173(defcustom ldap-coding-system 'utf-8 174 "*Coding system of LDAP string values. 175LDAP v3 specifies the coding system of strings to be UTF-8." 176 :type 'symbol 177 :group 'ldap) 178 179(defvar ldap-attribute-syntax-encoders 180 [nil ; 1 ACI Item N 181 nil ; 2 Access Point Y 182 nil ; 3 Attribute Type Description Y 183 nil ; 4 Audio N 184 nil ; 5 Binary N 185 nil ; 6 Bit String Y 186 ldap-encode-boolean ; 7 Boolean Y 187 nil ; 8 Certificate N 188 nil ; 9 Certificate List N 189 nil ; 10 Certificate Pair N 190 ldap-encode-country-string ; 11 Country String Y 191 ldap-encode-string ; 12 DN Y 192 nil ; 13 Data Quality Syntax Y 193 nil ; 14 Delivery Method Y 194 ldap-encode-string ; 15 Directory String Y 195 nil ; 16 DIT Content Rule Description Y 196 nil ; 17 DIT Structure Rule Description Y 197 nil ; 18 DL Submit Permission Y 198 nil ; 19 DSA Quality Syntax Y 199 nil ; 20 DSE Type Y 200 nil ; 21 Enhanced Guide Y 201 nil ; 22 Facsimile Telephone Number Y 202 nil ; 23 Fax N 203 nil ; 24 Generalized Time Y 204 nil ; 25 Guide Y 205 nil ; 26 IA5 String Y 206 number-to-string ; 27 INTEGER Y 207 nil ; 28 JPEG N 208 nil ; 29 Master And Shadow Access Points Y 209 nil ; 30 Matching Rule Description Y 210 nil ; 31 Matching Rule Use Description Y 211 nil ; 32 Mail Preference Y 212 nil ; 33 MHS OR Address Y 213 nil ; 34 Name And Optional UID Y 214 nil ; 35 Name Form Description Y 215 nil ; 36 Numeric String Y 216 nil ; 37 Object Class Description Y 217 nil ; 38 OID Y 218 nil ; 39 Other Mailbox Y 219 nil ; 40 Octet String Y 220 ldap-encode-address ; 41 Postal Address Y 221 nil ; 42 Protocol Information Y 222 nil ; 43 Presentation Address Y 223 ldap-encode-string ; 44 Printable String Y 224 nil ; 45 Subtree Specification Y 225 nil ; 46 Supplier Information Y 226 nil ; 47 Supplier Or Consumer Y 227 nil ; 48 Supplier And Consumer Y 228 nil ; 49 Supported Algorithm N 229 nil ; 50 Telephone Number Y 230 nil ; 51 Teletex Terminal Identifier Y 231 nil ; 52 Telex Number Y 232 nil ; 53 UTC Time Y 233 nil ; 54 LDAP Syntax Description Y 234 nil ; 55 Modify Rights Y 235 nil ; 56 LDAP Schema Definition Y 236 nil ; 57 LDAP Schema Description Y 237 nil ; 58 Substring Assertion Y 238 ] 239 "A vector of functions used to encode LDAP attribute values. 240The sequence of functions corresponds to the sequence of LDAP attribute syntax 241object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in 242RFC2252 section 4.3.2") 243 244(defvar ldap-attribute-syntax-decoders 245 [nil ; 1 ACI Item N 246 nil ; 2 Access Point Y 247 nil ; 3 Attribute Type Description Y 248 nil ; 4 Audio N 249 nil ; 5 Binary N 250 nil ; 6 Bit String Y 251 ldap-decode-boolean ; 7 Boolean Y 252 nil ; 8 Certificate N 253 nil ; 9 Certificate List N 254 nil ; 10 Certificate Pair N 255 ldap-decode-string ; 11 Country String Y 256 ldap-decode-string ; 12 DN Y 257 nil ; 13 Data Quality Syntax Y 258 nil ; 14 Delivery Method Y 259 ldap-decode-string ; 15 Directory String Y 260 nil ; 16 DIT Content Rule Description Y 261 nil ; 17 DIT Structure Rule Description Y 262 nil ; 18 DL Submit Permission Y 263 nil ; 19 DSA Quality Syntax Y 264 nil ; 20 DSE Type Y 265 nil ; 21 Enhanced Guide Y 266 nil ; 22 Facsimile Telephone Number Y 267 nil ; 23 Fax N 268 nil ; 24 Generalized Time Y 269 nil ; 25 Guide Y 270 nil ; 26 IA5 String Y 271 string-to-number ; 27 INTEGER Y 272 nil ; 28 JPEG N 273 nil ; 29 Master And Shadow Access Points Y 274 nil ; 30 Matching Rule Description Y 275 nil ; 31 Matching Rule Use Description Y 276 nil ; 32 Mail Preference Y 277 nil ; 33 MHS OR Address Y 278 nil ; 34 Name And Optional UID Y 279 nil ; 35 Name Form Description Y 280 nil ; 36 Numeric String Y 281 nil ; 37 Object Class Description Y 282 nil ; 38 OID Y 283 nil ; 39 Other Mailbox Y 284 nil ; 40 Octet String Y 285 ldap-decode-address ; 41 Postal Address Y 286 nil ; 42 Protocol Information Y 287 nil ; 43 Presentation Address Y 288 ldap-decode-string ; 44 Printable String Y 289 nil ; 45 Subtree Specification Y 290 nil ; 46 Supplier Information Y 291 nil ; 47 Supplier Or Consumer Y 292 nil ; 48 Supplier And Consumer Y 293 nil ; 49 Supported Algorithm N 294 nil ; 50 Telephone Number Y 295 nil ; 51 Teletex Terminal Identifier Y 296 nil ; 52 Telex Number Y 297 nil ; 53 UTC Time Y 298 nil ; 54 LDAP Syntax Description Y 299 nil ; 55 Modify Rights Y 300 nil ; 56 LDAP Schema Definition Y 301 nil ; 57 LDAP Schema Description Y 302 nil ; 58 Substring Assertion Y 303 ] 304 "A vector of functions used to decode LDAP attribute values. 305The sequence of functions corresponds to the sequence of LDAP attribute syntax 306object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in 307RFC2252 section 4.3.2") 308 309 310(defvar ldap-attribute-syntaxes-alist 311 '((createtimestamp . 24) 312 (modifytimestamp . 24) 313 (creatorsname . 12) 314 (modifiersname . 12) 315 (subschemasubentry . 12) 316 (attributetypes . 3) 317 (objectclasses . 37) 318 (matchingrules . 30) 319 (matchingruleuse . 31) 320 (namingcontexts . 12) 321 (altserver . 26) 322 (supportedextension . 38) 323 (supportedcontrol . 38) 324 (supportedsaslmechanisms . 15) 325 (supportedldapversion . 27) 326 (ldapsyntaxes . 16) 327 (ditstructurerules . 17) 328 (nameforms . 35) 329 (ditcontentrules . 16) 330 (objectclass . 38) 331 (aliasedobjectname . 12) 332 (cn . 15) 333 (sn . 15) 334 (serialnumber . 44) 335 (c . 15) 336 (l . 15) 337 (st . 15) 338 (street . 15) 339 (o . 15) 340 (ou . 15) 341 (title . 15) 342 (description . 15) 343 (searchguide . 25) 344 (businesscategory . 15) 345 (postaladdress . 41) 346 (postalcode . 15) 347 (postofficebox . 15) 348 (physicaldeliveryofficename . 15) 349 (telephonenumber . 50) 350 (telexnumber . 52) 351 (telexterminalidentifier . 51) 352 (facsimiletelephonenumber . 22) 353 (x121address . 36) 354 (internationalisdnnumber . 36) 355 (registeredaddress . 41) 356 (destinationindicator . 44) 357 (preferreddeliverymethod . 14) 358 (presentationaddress . 43) 359 (supportedapplicationcontext . 38) 360 (member . 12) 361 (owner . 12) 362 (roleoccupant . 12) 363 (seealso . 12) 364 (userpassword . 40) 365 (usercertificate . 8) 366 (cacertificate . 8) 367 (authorityrevocationlist . 9) 368 (certificaterevocationlist . 9) 369 (crosscertificatepair . 10) 370 (name . 15) 371 (givenname . 15) 372 (initials . 15) 373 (generationqualifier . 15) 374 (x500uniqueidentifier . 6) 375 (dnqualifier . 44) 376 (enhancedsearchguide . 21) 377 (protocolinformation . 42) 378 (distinguishedname . 12) 379 (uniquemember . 34) 380 (houseidentifier . 15) 381 (supportedalgorithms . 49) 382 (deltarevocationlist . 9) 383 (dmdname . 15)) 384 "A map of LDAP attribute names to their type object id minor number. 385This table is built from RFC2252 Section 5 and RFC2256 Section 5") 386 387 388;; Coding/decoding functions 389 390(defun ldap-encode-boolean (bool) 391 (if bool 392 "TRUE" 393 "FALSE")) 394 395(defun ldap-decode-boolean (str) 396 (cond 397 ((string-equal str "TRUE") 398 t) 399 ((string-equal str "FALSE") 400 nil) 401 (t 402 (error "Wrong LDAP boolean string: %s" str)))) 403 404(defun ldap-encode-country-string (str) 405 ;; We should do something useful here... 406 (if (not (= 2 (length str))) 407 (error "Invalid country string: %s" str))) 408 409(defun ldap-decode-string (str) 410 (decode-coding-string str ldap-coding-system)) 411 412(defun ldap-encode-string (str) 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 427 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)) 432 433(defun ldap-decode-attribute (attr) 434 "Decode the attribute/value pair ATTR according to LDAP rules. 435The attribute name is looked up in `ldap-attribute-syntaxes-alist' 436and the corresponding decoder is then retrieved from 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 451(defun ldap-search (filter &optional host attributes attrsonly withdn) 452 "Perform an LDAP search. 453FILTER is the search filter in RFC1558 syntax. 454HOST is the LDAP host on which to perform the search. 455ATTRIBUTES are the specific attributes to retrieve, nil means 456retrieve all. 457ATTRSONLY, if non-nil, retrieves the attributes only, without 458the associated values. 459If WITHDN is non-nil, each entry in the result will be prepended with 460its distinguished name WITHDN. 461Additional search parameters can be specified through 462`ldap-host-parameters-alist', which see." 463 (interactive "sFilter:") 464 (or host 465 (setq host ldap-default-host) 466 (error "No LDAP host specified")) 467 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) 468 result) 469 (setq result (ldap-search-internal (list* 'host host 470 'filter filter 471 'attributes attributes 472 'attrsonly attrsonly 473 'withdn withdn 474 host-plist))) 475 (if ldap-ignore-attribute-codings 476 result 477 (mapcar (lambda (record) 478 (mapcar 'ldap-decode-attribute record)) 479 result)))) 480 481 482(defun ldap-search-internal (search-plist) 483 "Perform a search on a LDAP server. 484SEARCH-PLIST is a property list describing the search request. 485Valid keys in that list are: 486 `host' is a string naming one or more (blank-separated) LDAP servers to 487to try to connect to. Each host name may optionally be of the form HOST:PORT. 488 `filter' is a filter string for the search as described in RFC 1558. 489 `attributes' is a list of strings indicating which attributes to retrieve 490for each matching entry. If nil, return all available attributes. 491 `attrsonly', if non-nil, indicates that only attributes are retrieved, 492not their associated values. 493 `auth' is one of the symbols `simple', `krbv41' or `krbv42'. 494 `base' is the base for the search as described in RFC 1779. 495 `scope' is one of the three symbols `sub', `base' or `one'. 496 `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax). 497 `auth' is one of the symbols `simple', `krbv41' or `krbv42' 498 `passwd' is the password to use for simple authentication. 499 `deref' is one of the symbols `never', `always', `search' or `find'. 500 `timelimit' is the timeout limit for the connection in seconds. 501 `sizelimit' is the maximum number of matches to return. 502 `withdn' if non-nil each entry in the result will be prepended with 503its distinguished name DN. 504The function returns a list of matching entries. Each entry is itself 505an alist of attribute/value pairs." 506 (let ((buf (get-buffer-create " *ldap-search*")) 507 (bufval (get-buffer-create " *ldap-value*")) 508 (host (or (plist-get search-plist 'host) 509 ldap-default-host)) 510 (filter (plist-get search-plist 'filter)) 511 (attributes (plist-get search-plist 'attributes)) 512 (attrsonly (plist-get search-plist 'attrsonly)) 513 (base (or (plist-get search-plist 'base) 514 ldap-default-base)) 515 (scope (plist-get search-plist 'scope)) 516 (binddn (plist-get search-plist 'binddn)) 517 (auth (plist-get search-plist 'auth)) 518 (passwd (plist-get search-plist 'passwd)) 519 (deref (plist-get search-plist 'deref)) 520 (timelimit (plist-get search-plist 'timelimit)) 521 (sizelimit (plist-get search-plist 'sizelimit)) 522 (withdn (plist-get search-plist 'withdn)) 523 (numres 0) 524 arglist dn name value record result) 525 (if (or (null filter) 526 (equal "" filter)) 527 (error "No search filter")) 528 (setq filter (cons filter attributes)) 529 (save-excursion 530 (set-buffer buf) 531 (erase-buffer) 532 (if (and host 533 (not (equal "" host))) 534 (setq arglist (nconc arglist (list (format "-h%s" host))))) 535 (if (and attrsonly 536 (not (equal "" attrsonly))) 537 (setq arglist (nconc arglist (list "-A")))) 538 (if (and base 539 (not (equal "" base))) 540 (setq arglist (nconc arglist (list (format "-b%s" base))))) 541 (if (and scope 542 (not (equal "" scope))) 543 (setq arglist (nconc arglist (list (format "-s%s" scope))))) 544 (if (and binddn 545 (not (equal "" binddn))) 546 (setq arglist (nconc arglist (list (format "-D%s" binddn))))) 547 (if (and auth 548 (equal 'simple auth)) 549 (setq arglist (nconc arglist (list "-x")))) 550 (if (and passwd 551 (not (equal "" passwd))) 552 (setq arglist (nconc arglist (list (format "-w%s" passwd))))) 553 (if (and deref 554 (not (equal "" deref))) 555 (setq arglist (nconc arglist (list (format "-a%s" deref))))) 556 (if (and timelimit 557 (not (equal "" timelimit))) 558 (setq arglist (nconc arglist (list (format "-l%s" timelimit))))) 559 (if (and sizelimit 560 (not (equal "" sizelimit))) 561 (setq arglist (nconc arglist (list (format "-z%s" sizelimit))))) 562 (eval `(call-process ldap-ldapsearch-prog 563 nil 564 buf 565 nil 566 ,@arglist 567 ,@ldap-ldapsearch-args 568 ,@filter)) 569 (insert "\n") 570 (goto-char (point-min)) 571 572 (while (re-search-forward "[\t\n\f]+ " nil t) 573 (replace-match "" nil nil)) 574 (goto-char (point-min)) 575 576 (if (looking-at "usage") 577 (error "Incorrect ldapsearch invocation") 578 (message "Parsing results... ") 579 ;; Skip error message when retrieving attribute list 580 (if (looking-at "Size limit exceeded") 581 (forward-line 1)) 582 (while (progn 583 (skip-chars-forward " \t\n") 584 (not (eobp))) 585 (setq dn (buffer-substring (point) (save-excursion 586 (end-of-line) 587 (point)))) 588 (forward-line 1) 589 (while (looking-at "^\\(\\w*\\)\\(;\\w*\\)?[=:\t ]+\\(<[\t ]*file://\\)\\(.*\\)$") 590 (setq name (match-string 1) 591 value (match-string 4)) 592 ;; Need to handle file:///D:/... as generated by OpenLDAP 593 ;; on DOS/Windows as local files. 594 (if (and (memq system-type '(windows-nt ms-dos)) 595 (eq (string-match "/\\(.:.*\\)$" value) 0)) 596 (setq value (match-string 1 value))) 597 ;; Do not try to open non-existent files 598 (if (equal value "") 599 (setq value " ") 600 (save-excursion 601 (set-buffer bufval) 602 (erase-buffer) 603 (set-buffer-multibyte nil) 604 (insert-file-contents-literally value) 605 (delete-file value) 606 (setq value (buffer-string)))) 607 (setq record (cons (list name value) 608 record)) 609 (forward-line 1)) 610 (setq result (cons (if withdn 611 (cons dn (nreverse record)) 612 (nreverse record)) result)) 613 (setq record nil) 614 (skip-chars-forward " \t\n") 615 (message "Parsing results... %d" numres) 616 (1+ numres)) 617 (message "Parsing results... done") 618 (nreverse result))))) 619 620(provide 'ldap) 621 622;;; arch-tag: 47913a76-6155-42e6-ac58-6d28b5d50eb0 623;;; ldap.el ends here 624