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.5 $
   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 (if (featurep 'mule)
 159                                   'utf-8
 160                                 nil)
 161   "*Coding system of LDAP string values.
 162 LDAP v3 specifies the coding system of strings to be UTF-8.
 163 Mule support is needed for this."
 164   :type 'symbol
 165   :group 'ldap)
 166
 167 (defvar ldap-attribute-syntax-encoders
 168   [nil                                  ; 1  ACI Item                        N
 169    nil                                  ; 2  Access Point                    Y
 170    nil                                  ; 3  Attribute Type Description      Y
 171    nil                                  ; 4  Audio                           N
 172    nil                                  ; 5  Binary                          N
 173    nil                                  ; 6  Bit String                      Y
 174    ldap-encode-boolean                  ; 7  Boolean                         Y
 175    nil                                  ; 8  Certificate                     N
 176    nil                                  ; 9  Certificate List                N
 177    nil                                  ; 10 Certificate Pair                N
 178    ldap-encode-country-string           ; 11 Country String                  Y
 179    ldap-encode-string                   ; 12 DN                              Y
 180    nil                                  ; 13 Data Quality Syntax             Y
 181    nil                                  ; 14 Delivery Method                 Y
 182    ldap-encode-string                   ; 15 Directory String                Y
 183    nil                                  ; 16 DIT Content Rule Description    Y
 184    nil                                  ; 17 DIT Structure Rule Description  Y
 185    nil                                  ; 18 DL Submit Permission            Y
 186    nil                                  ; 19 DSA Quality Syntax              Y
 187    nil                                  ; 20 DSE Type                        Y
 188    nil                                  ; 21 Enhanced Guide                  Y
 189    nil                                  ; 22 Facsimile Telephone Number      Y
 190    nil                                  ; 23 Fax                             N
 191    nil                                  ; 24 Generalized Time                Y
 192    nil                                  ; 25 Guide                           Y
 193    nil                                  ; 26 IA5 String                      Y
 194    number-to-string                     ; 27 INTEGER                         Y
 195    nil                                  ; 28 JPEG                            N
 196    nil                                  ; 29 Master And Shadow Access Points Y
 197    nil                                  ; 30 Matching Rule Description       Y
 198    nil                                  ; 31 Matching Rule Use Description   Y
 199    nil                                  ; 32 Mail Preference                 Y
 200    nil                                  ; 33 MHS OR Address                  Y
 201    nil                                  ; 34 Name And Optional UID           Y
 202    nil                                  ; 35 Name Form Description           Y
 203    nil                                  ; 36 Numeric String                  Y
 204    nil                                  ; 37 Object Class Description        Y
 205    nil                                  ; 38 OID                             Y
 206    nil                                  ; 39 Other Mailbox                   Y
 207    nil                                  ; 40 Octet String                    Y
 208    ldap-encode-address                  ; 41 Postal Address                  Y
 209    nil                                  ; 42 Protocol Information            Y
 210    nil                                  ; 43 Presentation Address            Y
 211    ldap-encode-string                   ; 44 Printable String                Y
 212    nil                                  ; 45 Subtree Specification           Y
 213    nil                                  ; 46 Supplier Information            Y
 214    nil                                  ; 47 Supplier Or Consumer            Y
 215    nil                                  ; 48 Supplier And Consumer           Y
 216    nil                                  ; 49 Supported Algorithm             N
 217    nil                                  ; 50 Telephone Number                Y
 218    nil                                  ; 51 Teletex Terminal Identifier     Y
 219    nil                                  ; 52 Telex Number                    Y
 220    nil                                  ; 53 UTC Time                        Y
 221    nil                                  ; 54 LDAP Syntax Description         Y
 222    nil                                  ; 55 Modify Rights                   Y
 223    nil                                  ; 56 LDAP Schema Definition          Y
 224    nil                                  ; 57 LDAP Schema Description         Y
 225    nil                                  ; 58 Substring Assertion             Y
 226    ]
 227   "A vector of functions used to encode LDAP attribute values.
 228 The sequence of functions corresponds to the sequence of LDAP attribute syntax
 229 object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in
 230 RFC2252 section 4.3.2")
 231
 232 (defvar ldap-attribute-syntax-decoders
 233   [nil                                  ; 1  ACI Item                        N
 234    nil                                  ; 2  Access Point                    Y
 235    nil                                  ; 3  Attribute Type Description      Y
 236    nil                                  ; 4  Audio                           N
 237    nil                                  ; 5  Binary                          N
 238    nil                                  ; 6  Bit String                      Y
 239    ldap-decode-boolean                  ; 7  Boolean                         Y
 240    nil                                  ; 8  Certificate                     N
 241    nil                                  ; 9  Certificate List                N
 242    nil                                  ; 10 Certificate Pair                N
 243    ldap-decode-string                   ; 11 Country String                  Y
 244    ldap-decode-string                   ; 12 DN                              Y
 245    nil                                  ; 13 Data Quality Syntax             Y
 246    nil                                  ; 14 Delivery Method                 Y
 247    ldap-decode-string                   ; 15 Directory String                Y
 248    nil                                  ; 16 DIT Content Rule Description    Y
 249    nil                                  ; 17 DIT Structure Rule Description  Y
 250    nil                                  ; 18 DL Submit Permission            Y
 251    nil                                  ; 19 DSA Quality Syntax              Y
 252    nil                                  ; 20 DSE Type                        Y
 253    nil                                  ; 21 Enhanced Guide                  Y
 254    nil                                  ; 22 Facsimile Telephone Number      Y
 255    nil                                  ; 23 Fax                             N
 256    nil                                  ; 24 Generalized Time                Y
 257    nil                                  ; 25 Guide                           Y
 258    nil                                  ; 26 IA5 String                      Y
 259    string-to-number                     ; 27 INTEGER                         Y
 260    nil                                  ; 28 JPEG                            N
 261    nil                                  ; 29 Master And Shadow Access Points Y
 262    nil                                  ; 30 Matching Rule Description       Y
 263    nil                                  ; 31 Matching Rule Use Description   Y
 264    nil                                  ; 32 Mail Preference                 Y
 265    nil                                  ; 33 MHS OR Address                  Y
 266    nil                                  ; 34 Name And Optional UID           Y
 267    nil                                  ; 35 Name Form Description           Y
 268    nil                                  ; 36 Numeric String                  Y
 269    nil                                  ; 37 Object Class Description        Y
 270    nil                                  ; 38 OID                             Y
 271    nil                                  ; 39 Other Mailbox                   Y
 272    nil                                  ; 40 Octet String                    Y
 273    ldap-decode-address                  ; 41 Postal Address                  Y
 274    nil                                  ; 42 Protocol Information            Y
 275    nil                                  ; 43 Presentation Address            Y
 276    ldap-decode-string                   ; 44 Printable String                Y
 277    nil                                  ; 45 Subtree Specification           Y
 278    nil                                  ; 46 Supplier Information            Y
 279    nil                                  ; 47 Supplier Or Consumer            Y
 280    nil                                  ; 48 Supplier And Consumer           Y
 281    nil                                  ; 49 Supported Algorithm             N
 282    nil                                  ; 50 Telephone Number                Y
 283    nil                                  ; 51 Teletex Terminal Identifier     Y
 284    nil                                  ; 52 Telex Number                    Y
 285    nil                                  ; 53 UTC Time                        Y
 286    nil                                  ; 54 LDAP Syntax Description         Y
 287    nil                                  ; 55 Modify Rights                   Y
 288    nil                                  ; 56 LDAP Schema Definition          Y
 289    nil                                  ; 57 LDAP Schema Description         Y
 290    nil                                  ; 58 Substring Assertion             Y
 291    ]
 292   "A vector of functions used to decode LDAP attribute values.
 293 The sequence of functions corresponds to the sequence of LDAP attribute syntax
 294 object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in
 295 RFC2252 section 4.3.2")
 296
 297
 298 (defvar ldap-attribute-syntaxes-alist
 299   '((createtimestamp . 24)
 300     (modifytimestamp . 24)
 301     (creatorsname . 12)
 302     (modifiersname . 12)
 303     (subschemasubentry . 12)
 304     (attributetypes . 3)
 305     (objectclasses . 37)
 306     (matchingrules . 30)
 307     (matchingruleuse . 31)
 308     (namingcontexts . 12)
 309     (altserver . 26)
 310     (supportedextension . 38)
 311     (supportedcontrol . 38)
 312     (supportedsaslmechanisms . 15)
 313     (supportedldapversion . 27)
 314     (ldapsyntaxes . 16)
 315     (ditstructurerules . 17)
 316     (nameforms . 35)
 317     (ditcontentrules . 16)
 318     (objectclass . 38)
 319     (aliasedobjectname . 12)
 320     (cn . 15)
 321     (sn . 15)
 322     (serialnumber . 44)
 323     (c . 15)
 324     (l . 15)
 325     (st . 15)
 326     (street . 15)
 327     (o . 15)
 328     (ou . 15)
 329     (title . 15)
 330     (description . 15)
 331     (searchguide . 25)
 332     (businesscategory . 15)
 333     (postaladdress . 41)
 334     (postalcode . 15)
 335     (postofficebox . 15)
 336     (physicaldeliveryofficename . 15)
 337     (telephonenumber . 50)
 338     (telexnumber . 52)
 339     (telexterminalidentifier . 51)
 340     (facsimiletelephonenumber . 22)
 341     (x121address . 36)
 342     (internationalisdnnumber . 36)
 343     (registeredaddress . 41)
 344     (destinationindicator . 44)
 345     (preferreddeliverymethod . 14)
 346     (presentationaddress . 43)
 347     (supportedapplicationcontext . 38)
 348     (member . 12)
 349     (owner . 12)
 350     (roleoccupant . 12)
 351     (seealso . 12)
 352     (userpassword . 40)
 353     (usercertificate . 8)
 354     (cacertificate . 8)
 355     (authorityrevocationlist . 9)
 356     (certificaterevocationlist . 9)
 357     (crosscertificatepair . 10)
 358     (name . 15)
 359     (givenname . 15)
 360     (initials . 15)
 361     (generationqualifier . 15)
 362     (x500uniqueidentifier . 6)
 363     (dnqualifier . 44)
 364     (enhancedsearchguide . 21)
 365     (protocolinformation . 42)
 366     (distinguishedname . 12)
 367     (uniquemember . 34)
 368     (houseidentifier . 15)
 369     (supportedalgorithms . 49)
 370     (deltarevocationlist . 9)
 371     (dmdname . 15))
 372   "A map of LDAP attribute names to their type object id minor number.
 373 This table is built from RFC2252 Section 5 and RFC2256 Section 5")
 374
 375
 376 ;; Coding/decoding functions
 377
 378 (defun ldap-encode-boolean (bool)
 379   (if bool
 380       "TRUE"
 381     "FALSE"))
 382
 383 (defun ldap-decode-boolean (str)
 384   (cond
 385    ((string-equal str "TRUE")
 386     t)
 387    ((string-equal str "FALSE")
 388     nil)
 389    (t
 390     (error "Wrong LDAP boolean string: %s" str))))
 391
 392 (defun ldap-encode-country-string (str)
 393   ;; We should do something useful here...
 394   (if (not (= 2 (length str)))
 395       (error "Invalid country string: %s" str)))
 396
 397 (defun ldap-decode-string (str)
 398   (decode-coding-string str ldap-coding-system))
 399
 400 (defun ldap-encode-string (str)
 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