mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-24 07:20:37 +00:00
ecf08f0621
dc4e6b1329; Update copyright years in more files64b3777631; Run set-copyright from admin.el8e1c56ae46; Add 2024 to copyright years # Conflicts: # doc/misc/modus-themes.org # doc/misc/texinfo.tex # etc/NEWS # etc/refcards/ru-refcard.tex # etc/themes/modus-operandi-theme.el # etc/themes/modus-themes.el # etc/themes/modus-vivendi-theme.el # lib/alloca.in.h # lib/binary-io.h # lib/c-ctype.h # lib/c-strcasecmp.c # lib/c-strncasecmp.c # lib/careadlinkat.c # lib/cloexec.c # lib/close-stream.c # lib/diffseq.h # lib/dup2.c # lib/filemode.h # lib/fpending.c # lib/fpending.h # lib/fsusage.c # lib/getgroups.c # lib/getloadavg.c # lib/gettext.h # lib/gettime.c # lib/gettimeofday.c # lib/group-member.c # lib/malloc.c # lib/md5-stream.c # lib/md5.c # lib/md5.h # lib/memmem.c # lib/memrchr.c # lib/nanosleep.c # lib/save-cwd.h # lib/sha1.c # lib/sig2str.c # lib/stdlib.in.h # lib/strtoimax.c # lib/strtol.c # lib/strtoll.c # lib/time_r.c # lib/xalloc-oversized.h # lisp/auth-source-pass.el # lisp/emacs-lisp/lisp-mnt.el # lisp/emacs-lisp/timer.el # lisp/info-look.el # lisp/jit-lock.el # lisp/loadhist.el # lisp/mail/rmail.el # lisp/net/ntlm.el # lisp/net/webjump.el # lisp/progmodes/asm-mode.el # lisp/progmodes/project.el # lisp/progmodes/sh-script.el # lisp/textmodes/flyspell.el # lisp/textmodes/reftex-toc.el # lisp/textmodes/reftex.el # lisp/textmodes/tex-mode.el # lisp/url/url-gw.el # m4/alloca.m4 # m4/clock_time.m4 # m4/d-type.m4 # m4/dirent_h.m4 # m4/dup2.m4 # m4/euidaccess.m4 # m4/fchmodat.m4 # m4/filemode.m4 # m4/fsusage.m4 # m4/getgroups.m4 # m4/getloadavg.m4 # m4/getrandom.m4 # m4/gettime.m4 # m4/gettimeofday.m4 # m4/gnulib-common.m4 # m4/group-member.m4 # m4/inttypes.m4 # m4/malloc.m4 # m4/manywarnings.m4 # m4/mempcpy.m4 # m4/memrchr.m4 # m4/mkostemp.m4 # m4/mktime.m4 # m4/nproc.m4 # m4/nstrftime.m4 # m4/pathmax.m4 # m4/pipe2.m4 # m4/pselect.m4 # m4/pthread_sigmask.m4 # m4/readlink.m4 # m4/realloc.m4 # m4/sig2str.m4 # m4/ssize_t.m4 # m4/stat-time.m4 # m4/stddef_h.m4 # m4/stdint.m4 # m4/stdio_h.m4 # m4/stdlib_h.m4 # m4/stpcpy.m4 # m4/strnlen.m4 # m4/strtoimax.m4 # m4/strtoll.m4 # m4/time_h.m4 # m4/timegm.m4 # m4/timer_time.m4 # m4/timespec.m4 # m4/unistd_h.m4 # m4/warnings.m4 # nt/configure.bat # nt/preprep.c # test/lisp/register-tests.el
758 lines
28 KiB
EmacsLisp
758 lines
28 KiB
EmacsLisp
;;; ldap.el --- client interface to LDAP for Emacs -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 1998-2024 Free Software Foundation, Inc.
|
|
|
|
;; Author: Oscar Figueiredo <oscar@cpe.fr>
|
|
;; Maintainer: emacs-devel@gnu.org
|
|
;; Created: April 1998
|
|
;; Keywords: comm
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; This package provides basic functionality to perform searches on LDAP
|
|
;; servers. It requires a command line utility generally named
|
|
;; `ldapsearch' to actually perform the searches. That program can be
|
|
;; found in all LDAP developer kits such as:
|
|
;; - UM-LDAP 3.3 (http://www.umich.edu/~dirsvcs/ldap/)
|
|
;; - OpenLDAP (https://www.openldap.org/)
|
|
|
|
;;; Code:
|
|
|
|
(require 'password-cache)
|
|
|
|
(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)))
|
|
|
|
(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)
|
|
(natnum :tag "Port number")))
|
|
|
|
(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")))
|
|
|
|
|
|
(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:
|
|
`auth-source' specifies whether or not to look up, via the
|
|
`auth-source' library, options which are not otherwise provided
|
|
in this list. See `ldap-search-internal'.
|
|
`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 "Use auth-source"
|
|
:inline t
|
|
(const :tag "Use auth-source" auth-source)
|
|
boolean)
|
|
(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)"))))))
|
|
|
|
(defcustom ldap-ldapsearch-prog "ldapsearch"
|
|
"The name of the ldapsearch command line program."
|
|
:type '(string :tag "`ldapsearch' Program"))
|
|
|
|
(defcustom ldap-ldapsearch-args nil
|
|
"A list of additional arguments to pass to `ldapsearch'."
|
|
:type '(repeat :tag "`ldapsearch' Arguments"
|
|
(string :tag "Argument")))
|
|
|
|
(defcustom ldap-ldapsearch-password-prompt-regexp "Enter LDAP Password: "
|
|
"Regexp used to recognize the `ldapsearch' program's password prompt."
|
|
:type 'regexp
|
|
:version "25.1")
|
|
|
|
(defcustom ldap-ignore-attribute-codings nil
|
|
"If non-nil, do not encode/decode LDAP attribute values."
|
|
:type 'boolean)
|
|
|
|
(defcustom ldap-default-attribute-decoder nil
|
|
"Decoder function to use for attributes whose syntax is unknown."
|
|
:type 'symbol)
|
|
|
|
(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)
|
|
|
|
(defvar ldap-attribute-syntax-encoders
|
|
[nil ; 1 ACI Item N
|
|
nil ; 2 Access Point Y
|
|
nil ; 3 Attribute Type Description Y
|
|
nil ; 4 Audio N
|
|
nil ; 5 Binary N
|
|
nil ; 6 Bit String Y
|
|
ldap-encode-boolean ; 7 Boolean Y
|
|
nil ; 8 Certificate N
|
|
nil ; 9 Certificate List N
|
|
nil ; 10 Certificate Pair N
|
|
ldap-encode-country-string ; 11 Country String Y
|
|
ldap-encode-string ; 12 DN Y
|
|
nil ; 13 Data Quality Syntax Y
|
|
nil ; 14 Delivery Method Y
|
|
ldap-encode-string ; 15 Directory String Y
|
|
nil ; 16 DIT Content Rule Description Y
|
|
nil ; 17 DIT Structure Rule Description Y
|
|
nil ; 18 DL Submit Permission Y
|
|
nil ; 19 DSA Quality Syntax Y
|
|
nil ; 20 DSE Type Y
|
|
nil ; 21 Enhanced Guide Y
|
|
nil ; 22 Facsimile Telephone Number Y
|
|
nil ; 23 Fax N
|
|
nil ; 24 Generalized Time Y
|
|
nil ; 25 Guide Y
|
|
nil ; 26 IA5 String Y
|
|
number-to-string ; 27 INTEGER Y
|
|
nil ; 28 JPEG N
|
|
nil ; 29 Master And Shadow Access Points Y
|
|
nil ; 30 Matching Rule Description Y
|
|
nil ; 31 Matching Rule Use Description Y
|
|
nil ; 32 Mail Preference Y
|
|
nil ; 33 MHS OR Address Y
|
|
nil ; 34 Name And Optional UID Y
|
|
nil ; 35 Name Form Description Y
|
|
nil ; 36 Numeric String Y
|
|
nil ; 37 Object Class Description Y
|
|
nil ; 38 OID Y
|
|
nil ; 39 Other Mailbox Y
|
|
nil ; 40 Octet String Y
|
|
ldap-encode-address ; 41 Postal Address Y
|
|
nil ; 42 Protocol Information Y
|
|
nil ; 43 Presentation Address Y
|
|
ldap-encode-string ; 44 Printable String Y
|
|
nil ; 45 Subtree Specification Y
|
|
nil ; 46 Supplier Information Y
|
|
nil ; 47 Supplier Or Consumer Y
|
|
nil ; 48 Supplier And Consumer Y
|
|
nil ; 49 Supported Algorithm N
|
|
nil ; 50 Telephone Number Y
|
|
nil ; 51 Teletex Terminal Identifier Y
|
|
nil ; 52 Telex Number Y
|
|
nil ; 53 UTC Time Y
|
|
nil ; 54 LDAP Syntax Description Y
|
|
nil ; 55 Modify Rights Y
|
|
nil ; 56 LDAP Schema Definition Y
|
|
nil ; 57 LDAP Schema Description Y
|
|
nil ; 58 Substring Assertion Y
|
|
]
|
|
"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 ; 1 ACI Item N
|
|
nil ; 2 Access Point Y
|
|
nil ; 3 Attribute Type Description Y
|
|
nil ; 4 Audio N
|
|
nil ; 5 Binary N
|
|
nil ; 6 Bit String Y
|
|
ldap-decode-boolean ; 7 Boolean Y
|
|
nil ; 8 Certificate N
|
|
nil ; 9 Certificate List N
|
|
nil ; 10 Certificate Pair N
|
|
ldap-decode-string ; 11 Country String Y
|
|
ldap-decode-string ; 12 DN Y
|
|
nil ; 13 Data Quality Syntax Y
|
|
nil ; 14 Delivery Method Y
|
|
ldap-decode-string ; 15 Directory String Y
|
|
nil ; 16 DIT Content Rule Description Y
|
|
nil ; 17 DIT Structure Rule Description Y
|
|
nil ; 18 DL Submit Permission Y
|
|
nil ; 19 DSA Quality Syntax Y
|
|
nil ; 20 DSE Type Y
|
|
nil ; 21 Enhanced Guide Y
|
|
nil ; 22 Facsimile Telephone Number Y
|
|
nil ; 23 Fax N
|
|
nil ; 24 Generalized Time Y
|
|
nil ; 25 Guide Y
|
|
nil ; 26 IA5 String Y
|
|
string-to-number ; 27 INTEGER Y
|
|
nil ; 28 JPEG N
|
|
nil ; 29 Master And Shadow Access Points Y
|
|
nil ; 30 Matching Rule Description Y
|
|
nil ; 31 Matching Rule Use Description Y
|
|
nil ; 32 Mail Preference Y
|
|
nil ; 33 MHS OR Address Y
|
|
nil ; 34 Name And Optional UID Y
|
|
nil ; 35 Name Form Description Y
|
|
nil ; 36 Numeric String Y
|
|
nil ; 37 Object Class Description Y
|
|
nil ; 38 OID Y
|
|
nil ; 39 Other Mailbox Y
|
|
nil ; 40 Octet String Y
|
|
ldap-decode-address ; 41 Postal Address Y
|
|
nil ; 42 Protocol Information Y
|
|
nil ; 43 Presentation Address Y
|
|
ldap-decode-string ; 44 Printable String Y
|
|
nil ; 45 Subtree Specification Y
|
|
nil ; 46 Supplier Information Y
|
|
nil ; 47 Supplier Or Consumer Y
|
|
nil ; 48 Supplier And Consumer Y
|
|
nil ; 49 Supported Algorithm N
|
|
nil ; 50 Telephone Number Y
|
|
nil ; 51 Teletex Terminal Identifier Y
|
|
nil ; 52 Telex Number Y
|
|
nil ; 53 UTC Time Y
|
|
nil ; 54 LDAP Syntax Description Y
|
|
nil ; 55 Modify Rights Y
|
|
nil ; 56 LDAP Schema Definition Y
|
|
nil ; 57 LDAP Schema Description Y
|
|
nil ; 58 Substring Assertion Y
|
|
]
|
|
"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)
|
|
(carlicense . 15)
|
|
(departmentnumber . 15)
|
|
(displayname . 15)
|
|
(employeenumber . 15)
|
|
(employeetype . 15)
|
|
(jpegphoto . 28)
|
|
(preferredlanguage . 15)
|
|
(usersmimecertificate . 5)
|
|
(userpkcs12 . 5))
|
|
"A map of LDAP attribute names to their type object id minor number.
|
|
This table is built from RFC2252 Section 5, RFC2256 Section 5 and
|
|
RFC2798 Section 9.1.1")
|
|
|
|
|
|
;; Coding/decoding functions
|
|
|
|
(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)
|
|
;; We should do something useful here...
|
|
(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")
|
|
"$"))
|
|
|
|
|
|
;; LDAP protocol functions
|
|
|
|
(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.
|
|
See `ldap-search-internal' for the description of return value."
|
|
(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 (ldap-search-internal `(host ,host
|
|
filter ,filter
|
|
attributes ,attributes
|
|
attrsonly ,attrsonly
|
|
withdn ,withdn
|
|
,@host-plist))))
|
|
(if ldap-ignore-attribute-codings
|
|
result
|
|
(mapcar (lambda (record)
|
|
(append (and withdn (list (car record)))
|
|
(mapcar #'ldap-decode-attribute
|
|
(if withdn (cdr record) record))))
|
|
result))))
|
|
|
|
(defun ldap-password-read (host)
|
|
"Read LDAP password for HOST.
|
|
If the password is cached, it is read from the cache, otherwise the user
|
|
is prompted for the password. If `password-cache' is non-nil the password
|
|
is verified and cached. The `password-cache-expiry' variable
|
|
controls for how long the password is cached.
|
|
|
|
This function can be specified for the `passwd' property in
|
|
`ldap-host-parameters-alist' when interactive password prompting
|
|
is desired for HOST."
|
|
;; Add ldap: namespace to allow empty string for default host.
|
|
(let* ((host-key (concat "ldap:" host))
|
|
(password (password-read
|
|
(format "Enter LDAP Password%s: "
|
|
(if (equal host "")
|
|
""
|
|
(format " for %s" host)))
|
|
host-key)))
|
|
(when (and password-cache
|
|
(not (password-in-cache-p host-key))
|
|
;; Confirm the password is valid before adding it to
|
|
;; the password cache. ldap-search-internal will throw
|
|
;; an error if the password is invalid.
|
|
(not (ldap-search-internal
|
|
`(host ,host
|
|
;; Specify an arbitrary filter that should
|
|
;; produce no results, since only
|
|
;; authentication success is of interest.
|
|
filter "emacs-test-password="
|
|
attributes nil
|
|
attrsonly nil
|
|
withdn nil
|
|
;; Preempt passwd ldap-password-read
|
|
;; setting in ldap-host-parameters-alist.
|
|
passwd ,password
|
|
,@(cdr
|
|
(assoc
|
|
host
|
|
ldap-host-parameters-alist))))))
|
|
(password-cache-add host-key password))
|
|
password))
|
|
|
|
(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).
|
|
`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 a list ATTRS of (ATTR VALUE) pairs; `dn' attribute is not
|
|
included.
|
|
When `withdn' is non-nil the result is instead an alist with
|
|
elements (DN . ATTRS), where DN is a string value and ATTRS is
|
|
same as above."
|
|
(let* ((buf (get-buffer-create " *ldap-search*"))
|
|
(bufval (get-buffer-create " *ldap-value*"))
|
|
(host (or (plist-get search-plist 'host)
|
|
ldap-default-host))
|
|
;; find entries with port "ldap" that match the requested host if any
|
|
(asfound (when (plist-get search-plist 'auth-source)
|
|
(nth 0 (auth-source-search :host (or host t)
|
|
:create t))))
|
|
;; if no host was requested, get it from the auth-source entry
|
|
(host (or host (plist-get asfound :host)))
|
|
;; get the password from the auth-source
|
|
(passwd (or (plist-get search-plist 'passwd)
|
|
(plist-get asfound :secret)))
|
|
;; convert the password from a function call if needed
|
|
(passwd (if (functionp passwd)
|
|
(if (eq passwd 'ldap-password-read)
|
|
(funcall passwd host)
|
|
(funcall passwd))
|
|
passwd))
|
|
;; get the binddn from the search-list or from the
|
|
;; auth-source user or binddn tokens
|
|
(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 (list "-LLL" "-tt"))
|
|
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
|
|
;; Use -H if host is a new-style LDAP URI.
|
|
(if (string-match "^[a-zA-Z]+://" host)
|
|
"-H%s"
|
|
"-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"))))
|
|
;; Allow passwd to be set to "", representing a blank password.
|
|
(if passwd
|
|
(setq arglist (nconc arglist (list "-W"))))
|
|
(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)))))
|
|
(if passwd
|
|
;; Leave process-connection-type at its default value. See
|
|
;; discussion in Bug#33050.
|
|
(let* ((proc-args (append arglist ldap-ldapsearch-args
|
|
filter))
|
|
(proc (apply #'start-process "ldapsearch" buf
|
|
ldap-ldapsearch-prog
|
|
proc-args)))
|
|
(while (null (progn
|
|
(goto-char (point-min))
|
|
(re-search-forward
|
|
ldap-ldapsearch-password-prompt-regexp
|
|
(point-max) t)))
|
|
(accept-process-output proc 1))
|
|
(process-send-string proc passwd)
|
|
(process-send-string proc "\n")
|
|
(while (not (memq (process-status proc) '(exit signal)))
|
|
(sit-for 0.1))
|
|
(let ((status (process-exit-status proc)))
|
|
(when (not (memql status '(0 4))) ; 4 = Size limit exceeded
|
|
;; Handle invalid credentials exit status specially
|
|
;; for ldap-password-read.
|
|
(if (eq status 49)
|
|
(error (concat "Incorrect LDAP password or"
|
|
" bind distinguished name (binddn)"))
|
|
(error "Failed ldapsearch invocation: %s \"%s\""
|
|
ldap-ldapsearch-prog
|
|
(mapconcat #'identity proc-args "\" \""))))))
|
|
(apply #'call-process ldap-ldapsearch-prog
|
|
;; Ignore stderr, which can corrupt results
|
|
nil (list buf nil) nil
|
|
(append arglist ldap-ldapsearch-args filter)))
|
|
(insert "\n")
|
|
(goto-char (point-min))
|
|
|
|
(while (re-search-forward (concat "[\t\n\f]+ \\|"
|
|
ldap-ldapsearch-password-prompt-regexp)
|
|
nil t)
|
|
(replace-match ""))
|
|
(goto-char (point-min))
|
|
|
|
(if (looking-at "usage")
|
|
(error "Incorrect ldapsearch invocation")
|
|
(message "Parsing results... ")
|
|
;; Skip error message when retrieving attribute list
|
|
(if (looking-at "Size limit exceeded")
|
|
(forward-line 1))
|
|
(while (progn
|
|
(skip-chars-forward " \t\n")
|
|
(not (eobp)))
|
|
(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))
|
|
(when (memq system-type '(windows-nt ms-dos))
|
|
;; Need to handle file:///D:/... as generated by
|
|
;; OpenLDAP on DOS/Windows as local files.
|
|
(save-match-data
|
|
(when (eq (string-match "/\\(.:.*\\)$" value) 0)
|
|
(setq value (match-string 1 value)))))
|
|
(cond ((match-string 3) ;normal value written to a file
|
|
(with-current-buffer bufval
|
|
(erase-buffer)
|
|
(set-buffer-multibyte nil)
|
|
(insert-file-contents-literally value)
|
|
(delete-file value)
|
|
(setq value (buffer-string))))
|
|
(;; dn is output inline
|
|
(string-equal-ignore-case name "dn")
|
|
(setq dn value
|
|
name nil
|
|
value nil))
|
|
(t (setq value " ")))
|
|
(and name value
|
|
(setq record (cons (list name value)
|
|
record)))
|
|
(forward-line 1))
|
|
(when dn
|
|
(cond (withdn
|
|
(push (cons dn (nreverse record))
|
|
result))
|
|
(record
|
|
(push (nreverse record) result))))
|
|
(setq record nil
|
|
dn nil)
|
|
(message "Parsing results... %d" numres)
|
|
(setq numres (1+ numres)))
|
|
(message "Parsing results... done")
|
|
(nreverse result)))))
|
|
|
|
(provide 'ldap)
|
|
|
|
;;; ldap.el ends here
|