123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649 |
- (require 'custom)
- (eval-when-compile (require 'cl))
- (autoload 'auth-source-search "auth-source")
- (defgroup ldap nil
- "Lightweight Directory Access Protocol."
- :version "21.1"
- :group 'comm)
- (defcustom ldap-default-host nil
- "Default LDAP server.
- A TCP port number can be appended to that name using a colon as
- a separator."
- :type '(choice (string :tag "Host name")
- (const :tag "Use library default" nil))
- :group 'ldap)
- (defcustom ldap-default-port nil
- "Default TCP port for LDAP connections.
- Initialized from the LDAP library at build time. Default value is 389."
- :type '(choice (const :tag "Use library default" nil)
- (integer :tag "Port number"))
- :group 'ldap)
- (defcustom ldap-default-base nil
- "Default base for LDAP searches.
- This is a string using the syntax of RFC 1779.
- For instance, \"o=ACME, c=US\" limits the search to the
- Acme organization in the United States."
- :type '(choice (const :tag "Use library default" nil)
- (string :tag "Search base"))
- :group 'ldap)
- (defcustom ldap-host-parameters-alist nil
- "Alist of host-specific options for LDAP transactions.
- The format of each list element is (HOST PROP1 VAL1 PROP2 VAL2 ...).
- HOST is the hostname of an LDAP server (with an optional TCP port number
- appended to it using a colon as a separator).
- PROPn and VALn are property/value pairs describing parameters for the server.
- Valid properties include:
- `binddn' is the distinguished name of the user to bind as
- (in RFC 1779 syntax).
- `passwd' is the password to use for simple authentication.
- `auth' is the authentication method to use.
- Possible values are: `simple', `krbv41' and `krbv42'.
- `base' is the base for the search as described in RFC 1779.
- `scope' is one of the three symbols `subtree', `base' or `onelevel'.
- `deref' is one of the symbols `never', `always', `search' or `find'.
- `timelimit' is the timeout limit for the connection in seconds.
- `sizelimit' is the maximum number of matches to return."
- :type '(repeat :menu-tag "Host parameters"
- :tag "Host parameters"
- (list :menu-tag "Host parameters"
- :tag "Host parameters"
- :value nil
- (string :tag "Host name")
- (checklist :inline t
- :greedy t
- (list
- :tag "Search Base"
- :inline t
- (const :tag "Search Base" base)
- string)
- (list
- :tag "Binding DN"
- :inline t
- (const :tag "Binding DN" binddn)
- string)
- (list
- :tag "Password"
- :inline t
- (const :tag "Password" passwd)
- string)
- (list
- :tag "Authentication Method"
- :inline t
- (const :tag "Authentication Method" auth)
- (choice
- (const :menu-tag "None" :tag "None" nil)
- (const :menu-tag "Simple" :tag "Simple" simple)
- (const :menu-tag "Kerberos 4.1" :tag "Kerberos 4.1" krbv41)
- (const :menu-tag "Kerberos 4.2" :tag "Kerberos 4.2" krbv42)))
- (list
- :tag "Search Scope"
- :inline t
- (const :tag "Search Scope" scope)
- (choice
- (const :menu-tag "Default" :tag "Default" nil)
- (const :menu-tag "Subtree" :tag "Subtree" subtree)
- (const :menu-tag "Base" :tag "Base" base)
- (const :menu-tag "One Level" :tag "One Level" onelevel)))
- (list
- :tag "Dereferencing"
- :inline t
- (const :tag "Dereferencing" deref)
- (choice
- (const :menu-tag "Default" :tag "Default" nil)
- (const :menu-tag "Never" :tag "Never" never)
- (const :menu-tag "Always" :tag "Always" always)
- (const :menu-tag "When searching" :tag "When searching" search)
- (const :menu-tag "When locating base" :tag "When locating base" find)))
- (list
- :tag "Time Limit"
- :inline t
- (const :tag "Time Limit" timelimit)
- (integer :tag "(in seconds)"))
- (list
- :tag "Size Limit"
- :inline t
- (const :tag "Size Limit" sizelimit)
- (integer :tag "(number of records)")))))
- :group 'ldap)
- (defcustom ldap-ldapsearch-prog "ldapsearch"
- "The name of the ldapsearch command line program."
- :type '(string :tag "`ldapsearch' Program")
- :group 'ldap)
- (defcustom ldap-ldapsearch-args '("-LL" "-tt")
- "A list of additional arguments to pass to `ldapsearch'."
- :type '(repeat :tag "`ldapsearch' Arguments"
- (string :tag "Argument"))
- :group 'ldap)
- (defcustom ldap-ignore-attribute-codings nil
- "If non-nil, do not encode/decode LDAP attribute values."
- :type 'boolean
- :group 'ldap)
- (defcustom ldap-default-attribute-decoder nil
- "Decoder function to use for attributes whose syntax is unknown."
- :type 'symbol
- :group 'ldap)
- (defcustom ldap-coding-system 'utf-8
- "Coding system of LDAP string values.
- LDAP v3 specifies the coding system of strings to be UTF-8."
- :type 'symbol
- :group 'ldap)
- (defvar ldap-attribute-syntax-encoders
- [nil
- nil
- nil
- nil
- nil
- nil
- ldap-encode-boolean
- nil
- nil
- nil
- ldap-encode-country-string
- ldap-encode-string
- nil
- nil
- ldap-encode-string
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- number-to-string
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- ldap-encode-address
- nil
- nil
- ldap-encode-string
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- ]
- "A vector of functions used to encode LDAP attribute values.
- The sequence of functions corresponds to the sequence of LDAP attribute syntax
- object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in
- RFC2252 section 4.3.2")
- (defvar ldap-attribute-syntax-decoders
- [nil
- nil
- nil
- nil
- nil
- nil
- ldap-decode-boolean
- nil
- nil
- nil
- ldap-decode-string
- ldap-decode-string
- nil
- nil
- ldap-decode-string
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- string-to-number
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- ldap-decode-address
- nil
- nil
- ldap-decode-string
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- nil
- ]
- "A vector of functions used to decode LDAP attribute values.
- The sequence of functions corresponds to the sequence of LDAP attribute syntax
- object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in
- RFC2252 section 4.3.2")
- (defvar ldap-attribute-syntaxes-alist
- '((createtimestamp . 24)
- (modifytimestamp . 24)
- (creatorsname . 12)
- (modifiersname . 12)
- (subschemasubentry . 12)
- (attributetypes . 3)
- (objectclasses . 37)
- (matchingrules . 30)
- (matchingruleuse . 31)
- (namingcontexts . 12)
- (altserver . 26)
- (supportedextension . 38)
- (supportedcontrol . 38)
- (supportedsaslmechanisms . 15)
- (supportedldapversion . 27)
- (ldapsyntaxes . 16)
- (ditstructurerules . 17)
- (nameforms . 35)
- (ditcontentrules . 16)
- (objectclass . 38)
- (aliasedobjectname . 12)
- (cn . 15)
- (sn . 15)
- (serialnumber . 44)
- (c . 15)
- (l . 15)
- (st . 15)
- (street . 15)
- (o . 15)
- (ou . 15)
- (title . 15)
- (description . 15)
- (searchguide . 25)
- (businesscategory . 15)
- (postaladdress . 41)
- (postalcode . 15)
- (postofficebox . 15)
- (physicaldeliveryofficename . 15)
- (telephonenumber . 50)
- (telexnumber . 52)
- (telexterminalidentifier . 51)
- (facsimiletelephonenumber . 22)
- (x121address . 36)
- (internationalisdnnumber . 36)
- (registeredaddress . 41)
- (destinationindicator . 44)
- (preferreddeliverymethod . 14)
- (presentationaddress . 43)
- (supportedapplicationcontext . 38)
- (member . 12)
- (owner . 12)
- (roleoccupant . 12)
- (seealso . 12)
- (userpassword . 40)
- (usercertificate . 8)
- (cacertificate . 8)
- (authorityrevocationlist . 9)
- (certificaterevocationlist . 9)
- (crosscertificatepair . 10)
- (name . 15)
- (givenname . 15)
- (initials . 15)
- (generationqualifier . 15)
- (x500uniqueidentifier . 6)
- (dnqualifier . 44)
- (enhancedsearchguide . 21)
- (protocolinformation . 42)
- (distinguishedname . 12)
- (uniquemember . 34)
- (houseidentifier . 15)
- (supportedalgorithms . 49)
- (deltarevocationlist . 9)
- (dmdname . 15))
- "A map of LDAP attribute names to their type object id minor number.
- This table is built from RFC2252 Section 5 and RFC2256 Section 5")
- (defun ldap-encode-boolean (bool)
- (if bool
- "TRUE"
- "FALSE"))
- (defun ldap-decode-boolean (str)
- (cond
- ((string-equal str "TRUE")
- t)
- ((string-equal str "FALSE")
- nil)
- (t
- (error "Wrong LDAP boolean string: %s" str))))
- (defun ldap-encode-country-string (str)
-
- (if (not (= 2 (length str)))
- (error "Invalid country string: %s" str)))
- (defun ldap-decode-string (str)
- (decode-coding-string str ldap-coding-system))
- (defun ldap-encode-string (str)
- (encode-coding-string str ldap-coding-system))
- (defun ldap-decode-address (str)
- (mapconcat 'ldap-decode-string
- (split-string str "\\$")
- "\n"))
- (defun ldap-encode-address (str)
- (mapconcat 'ldap-encode-string
- (split-string str "\n")
- "$"))
- (defun ldap-get-host-parameter (host parameter)
- "Get the value of PARAMETER for HOST in `ldap-host-parameters-alist'."
- (plist-get (cdr (assoc host ldap-host-parameters-alist))
- parameter))
- (defun ldap-decode-attribute (attr)
- "Decode the attribute/value pair ATTR according to LDAP rules.
- The attribute name is looked up in `ldap-attribute-syntaxes-alist'
- and the corresponding decoder is then retrieved from
- `ldap-attribute-syntax-decoders' and applied on the value(s)."
- (let* ((name (car attr))
- (values (cdr attr))
- (syntax-id (cdr (assq (intern (downcase name))
- ldap-attribute-syntaxes-alist)))
- decoder)
- (if syntax-id
- (setq decoder (aref ldap-attribute-syntax-decoders
- (1- syntax-id)))
- (setq decoder ldap-default-attribute-decoder))
- (if decoder
- (cons name (mapcar decoder values))
- attr)))
- (defun ldap-search (filter &optional host attributes attrsonly withdn)
- "Perform an LDAP search.
- FILTER is the search filter in RFC1558 syntax.
- HOST is the LDAP host on which to perform the search.
- ATTRIBUTES are the specific attributes to retrieve, nil means
- retrieve all.
- ATTRSONLY, if non-nil, retrieves the attributes only, without
- the associated values.
- If WITHDN is non-nil, each entry in the result will be prepended with
- its distinguished name WITHDN.
- Additional search parameters can be specified through
- `ldap-host-parameters-alist', which see."
- (interactive "sFilter:")
- (or host
- (setq host ldap-default-host)
- (error "No LDAP host specified"))
- (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
- result)
- (setq result (ldap-search-internal (list* 'host host
- 'filter filter
- 'attributes attributes
- 'attrsonly attrsonly
- 'withdn withdn
- host-plist)))
- (if ldap-ignore-attribute-codings
- result
- (mapcar (lambda (record)
- (mapcar 'ldap-decode-attribute record))
- result))))
- (defun ldap-search-internal (search-plist)
- "Perform a search on a LDAP server.
- SEARCH-PLIST is a property list describing the search request.
- Valid keys in that list are:
- `auth-source', if non-nil, will use `auth-source-search' and
- will grab the :host, :secret, :base, and (:user or :binddn)
- tokens into the `host', `passwd', `base', and `binddn' parameters
- respectively if they are not provided in SEARCH-PLIST. So for
- instance *each* of these netrc lines has the same effect if you
- ask for the host \"ldapserver:2400\":
- machine ldapserver:2400 login myDN secret myPassword base myBase
- machine ldapserver:2400 binddn myDN secret myPassword port ldap
- login myDN secret myPassword base myBase
- but if you have more than one in your netrc file, only the first
- matching one will be used. Note the \"port ldap\" part is NOT
- required.
- `host' is a string naming one or more (blank-separated) LDAP servers
- to try to connect to. Each host name may optionally be of the form HOST:PORT.
- `filter' is a filter string for the search as described in RFC 1558.
- `attributes' is a list of strings indicating which attributes to retrieve
- for each matching entry. If nil, return all available attributes.
- `attrsonly', if non-nil, indicates that only attributes are retrieved,
- not their associated values.
- `auth' is one of the symbols `simple', `krbv41' or `krbv42'.
- `base' is the base for the search as described in RFC 1779.
- `scope' is one of the three symbols `sub', `base' or `one'.
- `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax).
- `auth' is one of the symbols `simple', `krbv41' or `krbv42'
- `passwd' is the password to use for simple authentication.
- `deref' is one of the symbols `never', `always', `search' or `find'.
- `timelimit' is the timeout limit for the connection in seconds.
- `sizelimit' is the maximum number of matches to return.
- `withdn' if non-nil each entry in the result will be prepended with
- its distinguished name DN.
- The function returns a list of matching entries. Each entry is itself
- an alist of attribute/value pairs."
- (let* ((buf (get-buffer-create " *ldap-search*"))
- (bufval (get-buffer-create " *ldap-value*"))
- (host (or (plist-get search-plist 'host)
- ldap-default-host))
-
- (asfound (when (plist-get search-plist 'auth-source)
- (nth 0 (auth-source-search :host (or host t)
- :create t))))
-
- (host (or host (plist-get asfound :host)))
-
- (passwd (or (plist-get search-plist 'passwd)
- (plist-get asfound :secret)))
-
- (passwd (if (functionp passwd) (funcall passwd) passwd))
-
-
- (binddn (or (plist-get search-plist 'binddn)
- (plist-get asfound :user)
- (plist-get asfound :binddn)))
- (base (or (plist-get search-plist 'base)
- (plist-get asfound :base)
- ldap-default-base))
- (filter (plist-get search-plist 'filter))
- (attributes (plist-get search-plist 'attributes))
- (attrsonly (plist-get search-plist 'attrsonly))
- (scope (plist-get search-plist 'scope))
- (auth (plist-get search-plist 'auth))
- (deref (plist-get search-plist 'deref))
- (timelimit (plist-get search-plist 'timelimit))
- (sizelimit (plist-get search-plist 'sizelimit))
- (withdn (plist-get search-plist 'withdn))
- (numres 0)
- arglist dn name value record result)
- (if (or (null filter)
- (equal "" filter))
- (error "No search filter"))
- (setq filter (cons filter attributes))
- (with-current-buffer buf
- (erase-buffer)
- (if (and host
- (not (equal "" host)))
- (setq arglist (nconc arglist (list (format "-h%s" host)))))
- (if (and attrsonly
- (not (equal "" attrsonly)))
- (setq arglist (nconc arglist (list "-A"))))
- (if (and base
- (not (equal "" base)))
- (setq arglist (nconc arglist (list (format "-b%s" base)))))
- (if (and scope
- (not (equal "" scope)))
- (setq arglist (nconc arglist (list (format "-s%s" scope)))))
- (if (and binddn
- (not (equal "" binddn)))
- (setq arglist (nconc arglist (list (format "-D%s" binddn)))))
- (if (and auth
- (equal 'simple auth))
- (setq arglist (nconc arglist (list "-x"))))
- (if (and passwd
- (not (equal "" passwd)))
- (setq arglist (nconc arglist (list (format "-w%s" passwd)))))
- (if (and deref
- (not (equal "" deref)))
- (setq arglist (nconc arglist (list (format "-a%s" deref)))))
- (if (and timelimit
- (not (equal "" timelimit)))
- (setq arglist (nconc arglist (list (format "-l%s" timelimit)))))
- (if (and sizelimit
- (not (equal "" sizelimit)))
- (setq arglist (nconc arglist (list (format "-z%s" sizelimit)))))
- (apply #'call-process ldap-ldapsearch-prog
-
- nil (list buf nil) nil
- (append arglist ldap-ldapsearch-args filter))
- (insert "\n")
- (goto-char (point-min))
- (while (re-search-forward "[\t\n\f]+ " nil t)
- (replace-match "" nil nil))
- (goto-char (point-min))
- (if (looking-at "usage")
- (error "Incorrect ldapsearch invocation")
- (message "Parsing results... ")
-
- (if (looking-at "Size limit exceeded")
- (forward-line 1))
- (while (progn
- (skip-chars-forward " \t\n")
- (not (eobp)))
- (setq dn (buffer-substring (point) (point-at-eol)))
- (forward-line 1)
- (while (looking-at "^\\([A-Za-z][-A-Za-z0-9]*\
- \\|[0-9]+\\(?:\\.[0-9]+\\)*\\)\\(;[-A-Za-z0-9]+\\)*[=:\t ]+\
- \\(<[\t ]*file://\\)\\(.*\\)$")
- (setq name (match-string 1)
- value (match-string 4))
-
-
- (if (and (memq system-type '(windows-nt ms-dos))
- (eq (string-match "/\\(.:.*\\)$" value) 0))
- (setq value (match-string 1 value)))
-
- (if (equal value "")
- (setq value " ")
- (with-current-buffer bufval
- (erase-buffer)
- (set-buffer-multibyte nil)
- (insert-file-contents-literally value)
- (delete-file value)
- (setq value (buffer-string))))
- (setq record (cons (list name value)
- record))
- (forward-line 1))
- (cond (withdn
- (push (cons dn (nreverse record)) result))
- (record
- (push (nreverse record) result)))
- (setq record nil)
- (skip-chars-forward " \t\n")
- (message "Parsing results... %d" numres)
- (1+ numres))
- (message "Parsing results... done")
- (nreverse result)))))
- (provide 'ldap)
|