git.chise.org Git - chise/xemacs-chise.git.1/blob - lisp/ldap.el

   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
   8 ;; Version: $Revision: 1.7.2.6 $
   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
  24 ;; along with XEmacs; see the file COPYING.  If not, write to
  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
  30 ;;    servers using the LDAP protocol (RFC 1777).
  31
  32 ;;; Installation:
  33 ;;    LDAP support must have been built into XEmacs.
  34
  35
  36 ;;; Code:
  37
  38 (defgroup ldap nil
  39   "Lightweight Directory Access Protocol"
  40   :group 'comm)
  41
  42 (defcustom ldap-default-host nil
  43   "*Default LDAP server hostname.
  44 A TCP port number can be appended to that name using a colon as
  45 a separator."
  46   :type '(choice (string :tag "Host name")
  47                  (const :tag "Use library default" nil))
  48   :group 'ldap)
  49
  50 (defcustom ldap-default-port nil
  51   "*Default TCP port for LDAP connections.
  52 Initialized from the LDAP library at build time. Default value is 389."
  53   :type '(choice (const :tag "Use library default" nil)
  54                  (integer :tag "Port number"))
  55   :group 'ldap)
  56
  57 (defcustom ldap-default-base nil
  58   "*Default base for LDAP searches.
  59 This is a string using the syntax of RFC 1779.
  60 For instance, \"o=ACME, c=US\" limits the search to the
  61 Acme organization in the United States."
  62   :type '(choice (const :tag "Use library default" nil)
  63                  (string :tag "Search base"))
  64   :group 'ldap)
  65
  66
  67 (defcustom ldap-host-parameters-alist nil
  68   "*Alist of host-specific options for LDAP transactions.
  69 The format of each list element is:
  70 \(HOST PROP1 VAL1 PROP2 VAL2 ...)
  71 HOST is the hostname of an LDAP server (with an optional TCP port number
  72 appended to it  using a colon as a separator).
  73 PROPn and VALn are property/value pairs describing parameters for the server.
  74 Valid properties include:
  75   `binddn' is the distinguished name of the user to bind as
  76     (in RFC 1779 syntax).
  77   `passwd' is the password to use for simple authentication.
  78   `auth' is the authentication method to use.
  79     Possible values are: `simple', `krbv41' and `krbv42'.
  80   `base' is the base for the search as described in RFC 1779.
  81   `scope' is one of the three symbols `subtree', `base' or `onelevel'.
  82   `deref' is one of the symbols `never', `always', `search' or `find'.
  83   `timelimit' is the timeout limit for the connection in seconds.
  84   `sizelimit' is the maximum number of matches to return."
  85   :type '(repeat :menu-tag "Host parameters"
  86                  :tag "Host parameters"
  87                  (list :menu-tag "Host parameters"
  88                        :tag "Host parameters"
  89                        :value nil
  90                        (string :tag "Host name")
  91                        (checklist :inline t
  92                                   :greedy t
  93                                   (list
  94                                    :tag "Search Base"
  95                                    :inline t
  96                                    (const :tag "Search Base" base)
  97                                    string)
  98                                   (list
  99                                    :tag "Binding DN"
 100                                    :inline t
 101                                    (const :tag "Binding DN" binddn)
 102                                    string)
 103                                   (list
 104                                    :tag "Password"
 105                                    :inline t
 106                                    (const :tag "Password" passwd)
 107                                    string)
 108                                   (list
 109                                    :tag "Authentication Method"
 110                                    :inline t
 111                                    (const :tag "Authentication Method" auth)
 112                                    (choice
 113                                     (const :menu-tag "None" :tag "None" nil)
 114                                     (const :menu-tag "Simple" :tag "Simple" simple)
 115                                     (const :menu-tag "Kerberos 4.1" :tag "Kerberos 4.1" krbv41)
 116                                     (const :menu-tag "Kerberos 4.2" :tag "Kerberos 4.2" krbv42)))
 117                                   (list
 118                                    :tag "Search Scope"
 119                                    :inline t
 120                                    (const :tag "Search Scope" scope)
 121                                    (choice
 122                                     (const :menu-tag "Default" :tag "Default" nil)
 123                                     (const :menu-tag "Subtree" :tag "Subtree" subtree)
 124                                     (const :menu-tag "Base" :tag "Base" base)
 125                                     (const :menu-tag "One Level" :tag "One Level" onelevel)))
 126                                   (list
 127                                    :tag "Dereferencing"
 128                                    :inline t
 129                                    (const :tag "Dereferencing" deref)
 130                                    (choice
 131                                     (const :menu-tag "Default" :tag "Default" nil)
 132                                     (const :menu-tag "Never" :tag "Never" never)
 133                                     (const :menu-tag "Always" :tag "Always" always)
 134                                     (const :menu-tag "When searching" :tag "When searching" search)
 135                                     (const :menu-tag "When locating base" :tag "When locating base" find)))
 136                                   (list
 137                                    :tag "Time Limit"
 138                                    :inline t
 139                                    (const :tag "Time Limit" timelimit)
 140                                    (integer :tag "(in seconds)"))
 141                                   (list
 142                                    :tag "Size Limit"
 143                                    :inline t
 144                                    (const :tag "Size Limit" sizelimit)
 145                                    (integer :tag "(number of records)")))))
 146 :group 'ldap)
 147
 148 (defcustom ldap-ignore-attribute-codings nil
 149   "*If non-nil, do not perform any encoding/decoding on LDAP attribute values."
 150   :type 'boolean
 151   :group 'ldap)
 152
 153 (defcustom ldap-default-attribute-decoder nil
 154   "*Decoder function to use for attributes whose syntax is unknown."
 155   :type 'symbol
 156   :group 'ldap)
 157
 158 (defcustom ldap-coding-system nil
 159   "*Coding system of LDAP string values.
 160 LDAP v3 specifies the coding system of strings to be UTF-8.
 161 Mule support is needed for this."
 162   :type 'symbol
 163   :group 'ldap)
 164
 165 (defvar ldap-attribute-syntax-encoders
 166   [nil                                  ; 1  ACI Item                        N
 167    nil                                  ; 2  Access Point                    Y
 168    nil                                  ; 3  Attribute Type Description      Y
 169    nil                                  ; 4  Audio                           N
 170    nil                                  ; 5  Binary                          N
 171    nil                                  ; 6  Bit String                      Y
 172    ldap-encode-boolean                  ; 7  Boolean                         Y
 173    nil                                  ; 8  Certificate                     N
 174    nil                                  ; 9  Certificate List                N
 175    nil                                  ; 10 Certificate Pair                N
 176    ldap-encode-country-string           ; 11 Country String                  Y
 177    ldap-encode-string                   ; 12 DN                              Y
 178    nil                                  ; 13 Data Quality Syntax             Y
 179    nil                                  ; 14 Delivery Method                 Y
 180    ldap-encode-string                   ; 15 Directory String                Y
 181    nil                                  ; 16 DIT Content Rule Description    Y
 182    nil                                  ; 17 DIT Structure Rule Description  Y
 183    nil                                  ; 18 DL Submit Permission            Y
 184    nil                                  ; 19 DSA Quality Syntax              Y
 185    nil                                  ; 20 DSE Type                        Y
 186    nil                                  ; 21 Enhanced Guide                  Y
 187    nil                                  ; 22 Facsimile Telephone Number      Y
 188    nil                                  ; 23 Fax                             N
 189    nil                                  ; 24 Generalized Time                Y
 190    nil                                  ; 25 Guide                           Y
 191    nil                                  ; 26 IA5 String                      Y
 192    number-to-string                     ; 27 INTEGER                         Y
 193    nil                                  ; 28 JPEG                            N
 194    nil                                  ; 29 Master And Shadow Access Points Y
 195    nil                                  ; 30 Matching Rule Description       Y
 196    nil                                  ; 31 Matching Rule Use Description   Y
 197    nil                                  ; 32 Mail Preference                 Y
 198    nil                                  ; 33 MHS OR Address                  Y
 199    nil                                  ; 34 Name And Optional UID           Y
 200    nil                                  ; 35 Name Form Description           Y
 201    nil                                  ; 36 Numeric String                  Y
 202    nil                                  ; 37 Object Class Description        Y
 203    nil                                  ; 38 OID                             Y
 204    nil                                  ; 39 Other Mailbox                   Y
 205    nil                                  ; 40 Octet String                    Y
 206    ldap-encode-address                  ; 41 Postal Address                  Y
 207    nil                                  ; 42 Protocol Information            Y
 208    nil                                  ; 43 Presentation Address            Y
 209    ldap-encode-string                   ; 44 Printable String                Y
 210    nil                                  ; 45 Subtree Specification           Y
 211    nil                                  ; 46 Supplier Information            Y
 212    nil                                  ; 47 Supplier Or Consumer            Y
 213    nil                                  ; 48 Supplier And Consumer           Y
 214    nil                                  ; 49 Supported Algorithm             N
 215    nil                                  ; 50 Telephone Number                Y
 216    nil                                  ; 51 Teletex Terminal Identifier     Y
 217    nil                                  ; 52 Telex Number                    Y
 218    nil                                  ; 53 UTC Time                        Y
 219    nil                                  ; 54 LDAP Syntax Description         Y
 220    nil                                  ; 55 Modify Rights                   Y
 221    nil                                  ; 56 LDAP Schema Definition          Y
 222    nil                                  ; 57 LDAP Schema Description         Y
 223    nil                                  ; 58 Substring Assertion             Y
 224    ]
 225   "A vector of functions used to encode LDAP attribute values.
 226 The sequence of functions corresponds to the sequence of LDAP attribute syntax
 227 object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in
 228 RFC2252 section 4.3.2")
 229
 230 (defvar ldap-attribute-syntax-decoders
 231   [nil                                  ; 1  ACI Item                        N
 232    nil                                  ; 2  Access Point                    Y
 233    nil                                  ; 3  Attribute Type Description      Y
 234    nil                                  ; 4  Audio                           N
 235    nil                                  ; 5  Binary                          N
 236    nil                                  ; 6  Bit String                      Y
 237    ldap-decode-boolean                  ; 7  Boolean                         Y
 238    nil                                  ; 8  Certificate                     N
 239    nil                                  ; 9  Certificate List                N
 240    nil                                  ; 10 Certificate Pair                N
 241    ldap-decode-string                   ; 11 Country String                  Y
 242    ldap-decode-string                   ; 12 DN                              Y
 243    nil                                  ; 13 Data Quality Syntax             Y
 244    nil                                  ; 14 Delivery Method                 Y
 245    ldap-decode-string                   ; 15 Directory String                Y
 246    nil                                  ; 16 DIT Content Rule Description    Y
 247    nil                                  ; 17 DIT Structure Rule Description  Y
 248    nil                                  ; 18 DL Submit Permission            Y
 249    nil                                  ; 19 DSA Quality Syntax              Y
 250    nil                                  ; 20 DSE Type                        Y
 251    nil                                  ; 21 Enhanced Guide                  Y
 252    nil                                  ; 22 Facsimile Telephone Number      Y
 253    nil                                  ; 23 Fax                             N
 254    nil                                  ; 24 Generalized Time                Y
 255    nil                                  ; 25 Guide                           Y
 256    nil                                  ; 26 IA5 String                      Y
 257    string-to-number                     ; 27 INTEGER                         Y
 258    nil                                  ; 28 JPEG                            N
 259    nil                                  ; 29 Master And Shadow Access Points Y
 260    nil                                  ; 30 Matching Rule Description       Y
 261    nil                                  ; 31 Matching Rule Use Description   Y
 262    nil                                  ; 32 Mail Preference                 Y
 263    nil                                  ; 33 MHS OR Address                  Y
 264    nil                                  ; 34 Name And Optional UID           Y
 265    nil                                  ; 35 Name Form Description           Y
 266    nil                                  ; 36 Numeric String                  Y
 267    nil                                  ; 37 Object Class Description        Y
 268    nil                                  ; 38 OID                             Y
 269    nil                                  ; 39 Other Mailbox                   Y
 270    nil                                  ; 40 Octet String                    Y
 271    ldap-decode-address                  ; 41 Postal Address                  Y
 272    nil                                  ; 42 Protocol Information            Y
 273    nil                                  ; 43 Presentation Address            Y
 274    ldap-decode-string                   ; 44 Printable String                Y
 275    nil                                  ; 45 Subtree Specification           Y
 276    nil                                  ; 46 Supplier Information            Y
 277    nil                                  ; 47 Supplier Or Consumer            Y
 278    nil                                  ; 48 Supplier And Consumer           Y
 279    nil                                  ; 49 Supported Algorithm             N
 280    nil                                  ; 50 Telephone Number                Y
 281    nil                                  ; 51 Teletex Terminal Identifier     Y
 282    nil                                  ; 52 Telex Number                    Y
 283    nil                                  ; 53 UTC Time                        Y
 284    nil                                  ; 54 LDAP Syntax Description         Y
 285    nil                                  ; 55 Modify Rights                   Y
 286    nil                                  ; 56 LDAP Schema Definition          Y
 287    nil                                  ; 57 LDAP Schema Description         Y
 288    nil                                  ; 58 Substring Assertion             Y
 289    ]
 290   "A vector of functions used to decode LDAP attribute values.
 291 The sequence of functions corresponds to the sequence of LDAP attribute syntax
 292 object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in
 293 RFC2252 section 4.3.2")
 294
 295
 296 (defvar ldap-attribute-syntaxes-alist
 297   '((createtimestamp . 24)
 298     (modifytimestamp . 24)
 299     (creatorsname . 12)
 300     (modifiersname . 12)
 301     (subschemasubentry . 12)
 302     (attributetypes . 3)
 303     (objectclasses . 37)
 304     (matchingrules . 30)
 305     (matchingruleuse . 31)
 306     (namingcontexts . 12)
 307     (altserver . 26)
 308     (supportedextension . 38)
 309     (supportedcontrol . 38)
 310     (supportedsaslmechanisms . 15)
 311     (supportedldapversion . 27)
 312     (ldapsyntaxes . 16)
 313     (ditstructurerules . 17)
 314     (nameforms . 35)
 315     (ditcontentrules . 16)
 316     (objectclass . 38)
 317     (aliasedobjectname . 12)
 318     (cn . 15)
 319     (sn . 15)
 320     (serialnumber . 44)
 321     (c . 15)
 322     (l . 15)
 323     (st . 15)
 324     (street . 15)
 325     (o . 15)
 326     (ou . 15)
 327     (title . 15)
 328     (description . 15)
 329     (searchguide . 25)
 330     (businesscategory . 15)
 331     (postaladdress . 41)
 332     (postalcode . 15)
 333     (postofficebox . 15)
 334     (physicaldeliveryofficename . 15)
 335     (telephonenumber . 50)
 336     (telexnumber . 52)
 337     (telexterminalidentifier . 51)
 338     (facsimiletelephonenumber . 22)
 339     (x121address . 36)
 340     (internationalisdnnumber . 36)
 341     (registeredaddress . 41)
 342     (destinationindicator . 44)
 343     (preferreddeliverymethod . 14)
 344     (presentationaddress . 43)
 345     (supportedapplicationcontext . 38)
 346     (member . 12)
 347     (owner . 12)
 348     (roleoccupant . 12)
 349     (seealso . 12)
 350     (userpassword . 40)
 351     (usercertificate . 8)
 352     (cacertificate . 8)
 353     (authorityrevocationlist . 9)
 354     (certificaterevocationlist . 9)
 355     (crosscertificatepair . 10)
 356     (name . 15)
 357     (givenname . 15)
 358     (initials . 15)
 359     (generationqualifier . 15)
 360     (x500uniqueidentifier . 6)
 361     (dnqualifier . 44)
 362     (enhancedsearchguide . 21)
 363     (protocolinformation . 42)
 364     (distinguishedname . 12)
 365     (uniquemember . 34)
 366     (houseidentifier . 15)
 367     (supportedalgorithms . 49)
 368     (deltarevocationlist . 9)
 369     (dmdname . 15))
 370   "A map of LDAP attribute names to their type object id minor number.
 371 This table is built from RFC2252 Section 5 and RFC2256 Section 5")
 372
 373
 374 ;; Coding/decoding functions
 375
 376 (defun ldap-encode-boolean (bool)
 377   (if bool
 378       "TRUE"
 379     "FALSE"))
 380
 381 (defun ldap-decode-boolean (str)
 382   (cond
 383    ((string-equal str "TRUE")
 384     t)
 385    ((string-equal str "FALSE")
 386     nil)
 387    (t
 388     (error "Wrong LDAP boolean string: %s" str))))
 389
 390 (defun ldap-encode-country-string (str)
 391   ;; We should do something useful here...
 392   (if (not (= 2 (length str)))
 393       (error "Invalid country string: %s" str)))
 394
 395 (defun ldap-decode-string (str)
 396   (if (fboundp 'decode-coding-string)
 397       (decode-coding-string str ldap-coding-system)))
 398
 399 (defun ldap-encode-string (str)
 400    (if (fboundp 'encode-coding-string)
 401        (encode-coding-string str ldap-coding-system)))
 402
 403 (defun ldap-decode-address (str)
 404   (mapconcat 'ldap-decode-string
 405              (split-string str "\\$")
 406              "\n"))
 407
 408 (defun ldap-encode-address (str)
 409   (mapconcat 'ldap-encode-string
 410              (split-string str "\n")
 411              "$"))
 412
 413
 414 ;; LDAP protocol functions
 415
 416 (defun ldap-get-host-parameter (host parameter)
 417   "Get the value of PARAMETER for HOST in `ldap-host-parameters-alist'."
 418   (plist-get (cdr (assoc host ldap-host-parameters-alist))
 419              parameter))
 420
 421 (defun ldap-decode-attribute (attr)
 422   "Decode the attribute/value pair ATTR according to LDAP rules.
 423 The attribute name is looked up in `ldap-attribute-syntaxes-alist'
 424 and the corresponding decoder is then retrieved from
 425 `ldap-attribute-syntax-decoders' and applied on the value(s)."
 426   (let* ((name (car attr))
 427          (values (cdr attr))
 428          (syntax-id (cdr (assq (intern (downcase name))
 429                                ldap-attribute-syntaxes-alist)))
 430          decoder)
 431     (if syntax-id
 432         (setq decoder (aref ldap-attribute-syntax-decoders
 433                             (1- syntax-id)))
 434       (setq decoder ldap-default-attribute-decoder))
 435     (if decoder
 436         (cons name (mapcar decoder values))
 437       attr)))
 438
 439
 440 (defun ldap-search (filter &optional host attributes attrsonly withdn)
 441   "Perform an LDAP search.
 442 FILTER is the search filter in RFC1558 syntax, i.e., something that
 443 looks like \"(cn=John Smith)\".
 444 HOST is the LDAP host on which to perform the search.
 445 ATTRIBUTES is a list of attributes to retrieve; nil means retrieve all.
 446 If ATTRSONLY is non nil, the attributes will be retrieved without
 447 the associated values.
 448 If WITHDN is non-nil each entry in the result will be prepennded with
 449 its distinguished name DN.
 450 Additional search parameters can be specified through
 451 `ldap-host-parameters-alist' which see.
 452 The function returns a list of matching entries.  Each entry is itself
 453 an alist of attribute/value pairs optionally preceded by the DN of the
 454 entry according to the value of WITHDN."
 455   (interactive "sFilter:")
 456   (or host
 457       (setq host ldap-default-host)
 458       (error "No LDAP host specified"))
 459   (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
 460         ldap
 461         result)
 462     (message "Opening LDAP connection to %s..." host)
 463     (setq ldap (ldap-open host host-plist))
 464     (message "Searching with LDAP on %s..." host)
 465     (setq result (ldap-search-internal ldap filter
 466                                        (plist-get host-plist 'base)
 467                                        (plist-get host-plist 'scope)
 468                                        attributes attrsonly withdn))
 469     (ldap-close ldap)
 470     (if ldap-ignore-attribute-codings
 471         result
 472       (mapcar (function
 473                (lambda (record)
 474                  (mapcar 'ldap-decode-attribute record)))
 475               result))))
 476
 477 (provide 'ldap)
 478
 479 ;;; ldap.el ends here