mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-19 18:13:55 +00:00
lisp/net/{eudc,ldap}: Merge branch streamline-eudc-configuration
This commit is contained in:
Stefan Monnier
commit
ac5475dacb
@ -1,3 +1,8 @@
|
||||
2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
|
||||
|
||||
* eudc.texi (LDAP Configuration): Rename from LDAP Requirements
|
||||
and provide configuration examples.
|
||||
|
||||
2015-01-17 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* eieio.texi (Slot Options): Document :protection as unsupported.
|
||||
@ -28,8 +33,8 @@
|
||||
|
||||
2014-12-18 Eric Abrahamsen <eric@ericabrahamsen.net>
|
||||
|
||||
* gnus.texi (Gnus Registry Setup): Explain pruning changes. Mention
|
||||
gnus-registry-prune-factor. Explain sorting changes and
|
||||
* gnus.texi (Gnus Registry Setup): Explain pruning changes.
|
||||
Mention gnus-registry-prune-factor. Explain sorting changes and
|
||||
gnus-registry-default-sort-function. Correct file extension.
|
||||
|
||||
2014-12-17 Jay Belanger <jay.p.belanger@gmail.com>
|
||||
|
||||
@ -137,7 +137,7 @@ location, etc@enddots{} More information about LDAP can be found at
|
||||
@url{http://www.openldap.org/}.
|
||||
|
||||
EUDC requires external support to access LDAP directory servers
|
||||
(@pxref{LDAP Requirements})
|
||||
(@pxref{LDAP Configuration})
|
||||
|
||||
|
||||
@node CCSO PH/QI
|
||||
@ -213,17 +213,131 @@ email composition buffers (@pxref{Inline Query Expansion})
|
||||
@end lisp
|
||||
|
||||
@menu
|
||||
* LDAP Requirements:: EUDC needs external support for LDAP
|
||||
* LDAP Configuration:: EUDC needs external support for LDAP
|
||||
@end menu
|
||||
|
||||
@node LDAP Requirements
|
||||
@section LDAP Requirements
|
||||
@node LDAP Configuration
|
||||
@section LDAP Configuration
|
||||
|
||||
LDAP support is added by means of @file{ldap.el}, which is part of Emacs.
|
||||
@file{ldap.el} needs an external command line utility named
|
||||
@file{ldapsearch}, available as part of Open LDAP
|
||||
(@url{http://www.openldap.org/}).
|
||||
LDAP support is added by means of @file{ldap.el}, which is part of
|
||||
Emacs. @file{ldap.el} needs an external command line utility named
|
||||
@file{ldapsearch}, available as part of OpenLDAP
|
||||
(@url{http://www.openldap.org/}). The configurations in this section
|
||||
were tested with OpenLDAP 2.4.23.
|
||||
|
||||
The following examples use a base of
|
||||
@code{ou=people,dc=example,dc=com} and the host name
|
||||
@code{directory.example.com}, a server that supports LDAP-over-SSL
|
||||
(the @code{ldaps} protocol, with default port @code{636}) and which
|
||||
requires authentication by the user @code{emacsuser} with password
|
||||
@code{s3cr3t}.
|
||||
|
||||
These configurations are meant to be self-contained; that is, each
|
||||
provides everything required for sensible TAB-completion of email
|
||||
fields. BBDB lookups are attempted first; if a matching BBDB entry is
|
||||
found then EUDC will not attempt any LDAP lookups.
|
||||
|
||||
Wildcard LDAP lookups are supported using the @code{*} character. For
|
||||
example, attempting to TAB-complete the following:
|
||||
|
||||
@example
|
||||
To: * Smith
|
||||
@end example
|
||||
|
||||
will return all LDAP entries with surnames that begin with
|
||||
@code{Smith}. In every LDAP query it makes, EUDC implicitly appends
|
||||
the wildcard character to the end of the last word.
|
||||
|
||||
@subsection Emacs-only Configuration
|
||||
|
||||
Emacs can pass most required configuration options via the
|
||||
@file{ldapsearch} command-line. One exception is certificate
|
||||
configuration for LDAP-over-SSL, which must be specified in
|
||||
@file{/etc/openldap/ldap.conf}. On systems that provide such
|
||||
certificates as part of the @code{OpenLDAP} installation, this can be
|
||||
as simple as one line:
|
||||
|
||||
@example
|
||||
TLS_CACERTDIR /etc/openldap/certs
|
||||
@end example
|
||||
|
||||
In @file{.emacs}, these expressions suffice to configure EUDC for
|
||||
LDAP:
|
||||
|
||||
@lisp
|
||||
(eval-after-load "message"
|
||||
'(define-key message-mode-map (kbd "TAB") 'eudc-expand-inline))
|
||||
(customize-set-variable 'eudc-server-hotlist
|
||||
'(("" . bbdb)
|
||||
("ldaps://directory.example.com" . ldap)))
|
||||
(customize-set-variable 'ldap-host-parameters-alist
|
||||
'(("ldaps://directory.example.com"
|
||||
base "ou=people,dc=example,dc=com"
|
||||
binddn "example\\emacsuser"
|
||||
passwd ldap-password-read)))
|
||||
@end lisp
|
||||
|
||||
Specifying the function @code{ldap-password-read} for @code{passwd}
|
||||
will cause Emacs to prompt interactively for the password. The
|
||||
password will then be validated and cached, unless
|
||||
@code{password-cache} is nil. You can customize
|
||||
@code{password-cache-expiry} to control the duration for which the
|
||||
password is cached. If you want to clear the cache, call
|
||||
@code{password-reset}.
|
||||
|
||||
@subsection External Configuration
|
||||
|
||||
Your system may already be configured for a default LDAP server. For
|
||||
example, @file{/etc/openldap/ldap.conf} might contain:
|
||||
|
||||
@example
|
||||
BASE ou=people,dc=example,dc=com
|
||||
URI ldaps://directory.example.com
|
||||
TLS_CACERTDIR /etc/openldap/certs
|
||||
@end example
|
||||
|
||||
To authenticate, the @dfn{bind distinguished name (binddn)} is
|
||||
required, in this case, @code{example\emacsuser}, along with the
|
||||
password. These can be specified in @file{~/.authinfo.gpg} with the
|
||||
following line:
|
||||
|
||||
@example
|
||||
machine ldaps://directory.example.com binddn example\emacsuser password s3cr3t
|
||||
@end example
|
||||
|
||||
Then in the @file{.emacs} init file, these expressions suffice to
|
||||
configure EUDC for LDAP:
|
||||
|
||||
@lisp
|
||||
(eval-after-load "message"
|
||||
'(define-key message-mode-map (kbd "TAB") 'eudc-expand-inline))
|
||||
(customize-set-variable 'eudc-server-hotlist
|
||||
'(("" . bbdb)
|
||||
("ldaps://directory.example.com" . ldap)))
|
||||
(customize-set-variable 'ldap-host-parameters-alist
|
||||
'(("ldaps://directory.example.com"
|
||||
auth-source t)))
|
||||
@end lisp
|
||||
|
||||
For this example where we only care about one server, the server name
|
||||
can be omitted in @file{~/.authinfo.gpg} and @file{.emacs}, in which
|
||||
case @file{ldapsearch} defaults to the host name in
|
||||
@file{/etc/openldap/ldap.conf}.
|
||||
|
||||
The @file{~/.authinfo.gpg} line becomes:
|
||||
|
||||
@example
|
||||
binddn example\emacsuser password s3cr3t
|
||||
@end example
|
||||
|
||||
and the @file{.emacs} expressions become:
|
||||
|
||||
@lisp
|
||||
(eval-after-load "message"
|
||||
'(define-key message-mode-map (kbd "TAB") 'eudc-expand-inline))
|
||||
(customize-set-variable 'eudc-server-hotlist '(("" . bbdb) ("" . ldap)))
|
||||
(customize-set-variable 'ldap-host-parameters-alist '(("" auth-source t)))
|
||||
@end lisp
|
||||
|
||||
@node Usage
|
||||
@chapter Usage
|
||||
|
||||
@ -1,3 +1,88 @@
|
||||
2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
|
||||
|
||||
* net/ldap.el (ldap-search-internal): Mention binddn in invalid
|
||||
credentials error message.
|
||||
|
||||
2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
|
||||
|
||||
* net/ldap.el (ldap-password-read): Validate password before
|
||||
caching it.
|
||||
(ldap-search-internal): Handle ldapsearch error conditions.
|
||||
|
||||
2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
|
||||
|
||||
* net/ldap.el (ldap-password-read): Handle password-cache being nil.
|
||||
|
||||
2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
|
||||
|
||||
* net/eudc.el (eudc-expand-inline): Always restore former server
|
||||
and protocol.
|
||||
|
||||
2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
|
||||
|
||||
* net/eudcb-ldap.el: Don't nag the user in case a default base is
|
||||
provided by the LDAP system configuration file.
|
||||
|
||||
2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
|
||||
|
||||
* net/eudc.el (eudc-format-query): Preserve the
|
||||
eudc-inline-query-format ordering of attributes in the returned list.
|
||||
* net/eudcb-ldap.el (eudc-ldap-format-query-as-rfc1558):
|
||||
Append the LDAP wildcard character to the last attribute value.
|
||||
|
||||
2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
|
||||
|
||||
* net/eudcb-ldap.el (eudc-ldap-cleanup-record-simple):
|
||||
Downcase field names of LDAP results.
|
||||
(eudc-ldap-cleanup-record-filtering-addresses): Likewise.
|
||||
|
||||
2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
|
||||
|
||||
* net/ldap.el (ldap-ldapsearch-password-prompt): New defcustom.
|
||||
(ldap-search-internal): Send password to ldapsearch through a pipe
|
||||
instead of via the command line.
|
||||
|
||||
2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
|
||||
|
||||
* net/ldap.el: Require password-cache.
|
||||
(ldap-password-read): New function.
|
||||
(ldap-search-internal): Call ldap-password-read when it is
|
||||
configured to be called.
|
||||
|
||||
2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
|
||||
|
||||
* net/eudc-vars.el (eudc-expansion-overwrites-query):
|
||||
Change default to nil.
|
||||
|
||||
2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
|
||||
|
||||
* net/eudc.el (eudc-expand-inline): Ignore text properties of
|
||||
string-to-expand.
|
||||
|
||||
2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
|
||||
|
||||
* net/eudc-vars.el (eudc-inline-expansion-format): Default to a
|
||||
format that includes first name and surname.
|
||||
|
||||
2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
|
||||
|
||||
* net/eudc-vars.el (eudc-inline-query-format): Change default to
|
||||
query email and first name instead of surname.
|
||||
|
||||
2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
|
||||
|
||||
* net/ldap.el (ldap-search-internal): Support new-style LDAP URIs.
|
||||
|
||||
2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
|
||||
|
||||
* net/eudc-vars.el (eudc-server): Adjust docstring to mention
|
||||
eudc-server-hotlist.
|
||||
(eudc-server-hotlist): Move from eudc.el and make defcustom.
|
||||
* net/eudc.el (eudc-server-hotlist): Move to eudc-vars.el.
|
||||
(eudc-set-server): Allow setting protocol to nil.
|
||||
(eudc-expand-inline): Support hotlist-only expansions when server
|
||||
is not set.
|
||||
|
||||
2015-01-23 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* emacs-lisp/cl-generic.el (cl-no-primary-method): New fun and error.
|
||||
|
||||
@ -41,14 +41,36 @@
|
||||
"The name or IP address of the directory server.
|
||||
A port number may be specified by appending a colon and a
|
||||
number to the name of the server. Use `localhost' if the directory
|
||||
server resides on your computer (BBDB backend)."
|
||||
:type '(choice (string :tag "Server") (const :tag "None" nil))
|
||||
:group 'eudc)
|
||||
server resides on your computer (BBDB backend).
|
||||
|
||||
To specify multiple servers, customize eudc-server-hotlist
|
||||
instead."
|
||||
:type '(choice (string :tag "Server") (const :tag "None" nil)))
|
||||
|
||||
;; Known protocols (used in completion)
|
||||
;; Not to be mistaken with `eudc-supported-protocols'
|
||||
(defvar eudc-known-protocols '(bbdb ph ldap))
|
||||
|
||||
(defcustom eudc-server-hotlist nil
|
||||
"Directory servers to query.
|
||||
This is an alist of the form (SERVER . PROTOCOL). SERVER is the
|
||||
host name or URI of the server, PROTOCOL is a symbol representing
|
||||
the EUDC backend with which to access the server.
|
||||
|
||||
The BBDB backend ignores SERVER; `localhost' can be used as a
|
||||
placeholder string."
|
||||
:tag "Directory Servers to Query"
|
||||
:type `(repeat (cons :tag "Directory Server"
|
||||
(string :tag "Server Host Name or URI")
|
||||
(choice :tag "Protocol"
|
||||
:menu-tag "Protocol"
|
||||
,@(mapcar (lambda (s)
|
||||
(list 'const
|
||||
':tag (symbol-name s) s))
|
||||
eudc-known-protocols)
|
||||
(const :tag "None" nil))))
|
||||
:version "25.1")
|
||||
|
||||
(defvar eudc-supported-protocols nil
|
||||
"Protocols currently supported by EUDC.
|
||||
This variable is updated when protocol-specific libraries
|
||||
@ -61,15 +83,13 @@ Supported protocols are specified by `eudc-supported-protocols'."
|
||||
,@(mapcar (lambda (s)
|
||||
(list 'const ':tag (symbol-name s) s))
|
||||
eudc-known-protocols)
|
||||
(const :tag "None" nil))
|
||||
:group 'eudc)
|
||||
(const :tag "None" nil)))
|
||||
|
||||
|
||||
(defcustom eudc-strict-return-matches t
|
||||
"Ignore or allow entries not containing all requested return attributes.
|
||||
If non-nil, such entries are ignored."
|
||||
:type 'boolean
|
||||
:group 'eudc)
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom eudc-default-return-attributes nil
|
||||
"A list of default attributes to extract from directory entries.
|
||||
@ -82,8 +102,7 @@ server."
|
||||
(repeat :menu-tag "Attribute list"
|
||||
:tag "Attribute name"
|
||||
:value (nil)
|
||||
(symbol :tag "Attribute name")))
|
||||
:group 'eudc)
|
||||
(symbol :tag "Attribute name"))))
|
||||
|
||||
(defcustom eudc-multiple-match-handling-method 'select
|
||||
"What to do when multiple entries match an inline expansion query.
|
||||
@ -102,8 +121,7 @@ Possible values are:
|
||||
(const :menu-tag "Abort Operation"
|
||||
:tag "Abort Operation" abort)
|
||||
(const :menu-tag "Default (Use First)"
|
||||
:tag "Default (Use First)" nil))
|
||||
:group 'eudc)
|
||||
:tag "Default (Use First)" nil)))
|
||||
|
||||
(defcustom eudc-duplicate-attribute-handling-method '((email . duplicate))
|
||||
"A method to handle entries containing duplicate attributes.
|
||||
@ -130,10 +148,10 @@ different values."
|
||||
(const :menu-tag "List" list)
|
||||
(const :menu-tag "First" first)
|
||||
(const :menu-tag "Concat" concat)
|
||||
(const :menu-tag "Duplicate" duplicate)))))
|
||||
:group 'eudc)
|
||||
(const :menu-tag "Duplicate" duplicate))))))
|
||||
|
||||
(defcustom eudc-inline-query-format '((name)
|
||||
(defcustom eudc-inline-query-format '((email)
|
||||
(firstname)
|
||||
(firstname name))
|
||||
"Format of an inline expansion query.
|
||||
This is a list of FORMATs. A FORMAT is itself a list of one or more
|
||||
@ -160,14 +178,16 @@ must be set in a protocol/server-local fashion, see `eudc-server-set' and
|
||||
(const :menu-tag "Email Address" :tag "Email Address" email)
|
||||
(const :menu-tag "Phone" :tag "Phone" phone)
|
||||
(symbol :menu-tag "Other" :tag "Attribute name"))))
|
||||
:group 'eudc)
|
||||
:version "25.1")
|
||||
|
||||
(defcustom eudc-expansion-overwrites-query t
|
||||
;; Default to nil so that the most common use of eudc-expand-inline,
|
||||
;; where replace is nil, does not affect the kill ring.
|
||||
(defcustom eudc-expansion-overwrites-query nil
|
||||
"If non-nil, expanding a query overwrites the query string."
|
||||
:type 'boolean
|
||||
:group 'eudc)
|
||||
:version "25.1")
|
||||
|
||||
(defcustom eudc-inline-expansion-format '("%s" email)
|
||||
(defcustom eudc-inline-expansion-format '("%s %s <%s>" firstname name email)
|
||||
"A list specifying the format of the expansion of inline queries.
|
||||
This variable controls what `eudc-expand-inline' actually inserts in
|
||||
the buffer. First element is a string passed to `format'. Remaining
|
||||
@ -185,7 +205,7 @@ are passed as additional arguments to `format'."
|
||||
(const :menu-tag "Phone" :tag "Phone" phone)
|
||||
(symbol :menu-tag "Other")
|
||||
(symbol :tag "Attribute name"))))
|
||||
:group 'eudc)
|
||||
:version "25.1")
|
||||
|
||||
(defcustom eudc-inline-expansion-servers 'server-then-hotlist
|
||||
"Which servers to contact for the expansion of inline queries.
|
||||
@ -198,8 +218,7 @@ Possible values are:
|
||||
:menu-tag "Servers"
|
||||
(const :menu-tag "Current server" current-server)
|
||||
(const :menu-tag "Servers in the hotlist" hotlist)
|
||||
(const :menu-tag "Current server then hotlist" server-then-hotlist))
|
||||
:group 'eudc)
|
||||
(const :menu-tag "Current server then hotlist" server-then-hotlist)))
|
||||
|
||||
(defcustom eudc-max-servers-to-query nil
|
||||
"Maximum number of servers to query for an inline expansion.
|
||||
@ -213,8 +232,7 @@ If nil, query all servers available from `eudc-inline-expansion-servers'."
|
||||
(const :menu-tag "3" 3)
|
||||
(const :menu-tag "4" 4)
|
||||
(const :menu-tag "5" 5)
|
||||
(integer :menu-tag "Set"))
|
||||
:group 'eudc)
|
||||
(integer :menu-tag "Set")))
|
||||
|
||||
(defcustom eudc-query-form-attributes '(name firstname email phone)
|
||||
"A list of attributes presented in the query form."
|
||||
@ -226,8 +244,7 @@ If nil, query all servers available from `eudc-inline-expansion-servers'."
|
||||
(const :menu-tag "Surname" :tag "Surname" name)
|
||||
(const :menu-tag "Email Address" :tag "Email Address" email)
|
||||
(const :menu-tag "Phone" :tag "Phone" phone)
|
||||
(symbol :menu-tag "Other" :tag "Attribute name")))
|
||||
:group 'eudc)
|
||||
(symbol :menu-tag "Other" :tag "Attribute name"))))
|
||||
|
||||
(defcustom eudc-user-attribute-names-alist '((url . "URL")
|
||||
(callsign . "HAM Call Sign")
|
||||
@ -257,15 +274,13 @@ at `_' characters and capitalizing the individual words."
|
||||
:tag "User-defined Names of Directory Attributes"
|
||||
:type '(repeat (cons :tag "Field"
|
||||
(symbol :tag "Directory attribute")
|
||||
(string :tag "User friendly name ")))
|
||||
:group 'eudc)
|
||||
(string :tag "User friendly name "))))
|
||||
|
||||
(defcustom eudc-use-raw-directory-names nil
|
||||
"If non-nil, use attributes names as defined in the directory.
|
||||
Otherwise, directory query/response forms display the user attribute
|
||||
names defined in `eudc-user-attribute-names-alist'."
|
||||
:type 'boolean
|
||||
:group 'eudc)
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom eudc-attribute-display-method-alist nil
|
||||
"An alist specifying methods to display attribute values.
|
||||
@ -277,8 +292,7 @@ attribute values for display."
|
||||
:tag "Attribute Decoding Functions"
|
||||
:type '(repeat (cons :tag "Attribute"
|
||||
(symbol :tag "Name")
|
||||
(symbol :tag "Display Function")))
|
||||
:group 'eudc)
|
||||
(symbol :tag "Display Function"))))
|
||||
|
||||
(defcustom eudc-external-viewers '(("ImageMagick" "display" "-")
|
||||
("ShowAudio" "showaudio"))
|
||||
@ -295,18 +309,15 @@ arguments that should be passed to the program."
|
||||
(repeat
|
||||
:tag "Arguments"
|
||||
:inline t
|
||||
(string :tag "Argument"))))
|
||||
:group 'eudc)
|
||||
(string :tag "Argument")))))
|
||||
|
||||
(defcustom eudc-options-file "~/.eudc-options"
|
||||
"A file where the `servers' hotlist is stored."
|
||||
:type '(file :Tag "File Name:")
|
||||
:group 'eudc)
|
||||
:type '(file :Tag "File Name:"))
|
||||
|
||||
(defcustom eudc-mode-hook nil
|
||||
"Normal hook run on entry to EUDC mode."
|
||||
:type '(repeat (sexp :tag "Hook definition"))
|
||||
:group 'eudc)
|
||||
:type 'hook)
|
||||
|
||||
;;}}}
|
||||
|
||||
@ -341,8 +352,7 @@ BBDB fields. SPECs are sexps which are evaluated:
|
||||
:tag "BBDB to PH Field Name Mapping"
|
||||
:type '(repeat (cons :tag "Field Name"
|
||||
(symbol :tag "BBDB Field")
|
||||
(sexp :tag "Conversion Spec")))
|
||||
:group 'eudc-ph)
|
||||
(sexp :tag "Conversion Spec"))))
|
||||
|
||||
;;}}}
|
||||
|
||||
@ -376,8 +386,7 @@ BBDB fields. SPECs are sexps which are evaluated:
|
||||
:tag "BBDB to LDAP Attribute Names Mapping"
|
||||
:type '(repeat (cons :tag "Field Name"
|
||||
(symbol :tag "BBDB Field")
|
||||
(sexp :tag "Conversion Spec")))
|
||||
:group 'eudc-ldap)
|
||||
(sexp :tag "Conversion Spec"))))
|
||||
|
||||
;;}}}
|
||||
|
||||
@ -391,14 +400,12 @@ BBDB fields. SPECs are sexps which are evaluated:
|
||||
"If non-nil, BBDB address and phone locations are used as attribute names.
|
||||
This has no effect on queries (you can't search for a specific location)
|
||||
but influences the way records are displayed."
|
||||
:type 'boolean
|
||||
:group 'eudc-bbdb)
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom eudc-bbdb-enable-substring-matches t
|
||||
"If non-nil, authorize substring match in the same way BBDB does.
|
||||
Otherwise records must match queries exactly."
|
||||
:type 'boolean
|
||||
:group 'eudc-bbdb)
|
||||
:type 'boolean)
|
||||
|
||||
;;}}}
|
||||
|
||||
|
||||
@ -76,10 +76,6 @@
|
||||
|
||||
(defvar mode-popup-menu)
|
||||
|
||||
;; List of known servers
|
||||
;; Alist of (SERVER . PROTOCOL)
|
||||
(defvar eudc-server-hotlist nil)
|
||||
|
||||
;; List of variables that have server- or protocol-local bindings
|
||||
(defvar eudc-local-vars nil)
|
||||
|
||||
@ -688,7 +684,8 @@ server for future sessions."
|
||||
(cons (symbol-name elt)
|
||||
elt))
|
||||
eudc-known-protocols)))))
|
||||
(unless (or (member protocol
|
||||
(unless (or (null protocol)
|
||||
(member protocol
|
||||
eudc-supported-protocols)
|
||||
(load (concat "eudcb-" (symbol-name protocol)) t))
|
||||
(error "Unsupported protocol: %s" protocol))
|
||||
@ -766,7 +763,6 @@ otherwise a list of symbols is returned."
|
||||
format (cdr format)))
|
||||
;; If the same attribute appears more than once, merge
|
||||
;; the corresponding values
|
||||
(setq query-alist (nreverse query-alist))
|
||||
(while query-alist
|
||||
(setq key (eudc-caar query-alist)
|
||||
val (eudc-cdar query-alist)
|
||||
@ -812,19 +808,29 @@ If REPLACE is non-nil, then this expansion replaces the name in the buffer.
|
||||
Multiple servers can be tried with the same query until one finds a match,
|
||||
see `eudc-inline-expansion-servers'"
|
||||
(interactive)
|
||||
(if (memq eudc-inline-expansion-servers
|
||||
'(current-server server-then-hotlist))
|
||||
(or eudc-server
|
||||
(call-interactively 'eudc-set-server))
|
||||
(cond
|
||||
((eq eudc-inline-expansion-servers 'current-server)
|
||||
(or eudc-server
|
||||
(call-interactively 'eudc-set-server)))
|
||||
((eq eudc-inline-expansion-servers 'server-then-hotlist)
|
||||
(or eudc-server
|
||||
;; Allow server to be nil if hotlist is set.
|
||||
eudc-server-hotlist
|
||||
(call-interactively 'eudc-set-server)))
|
||||
((eq eudc-inline-expansion-servers 'hotlist)
|
||||
(or eudc-server-hotlist
|
||||
(error "No server in the hotlist")))
|
||||
(t
|
||||
(error "Wrong value for `eudc-inline-expansion-servers': %S"
|
||||
eudc-inline-expansion-servers)))
|
||||
(let* ((end (point))
|
||||
(beg (save-excursion
|
||||
(if (re-search-backward "\\([:,]\\|^\\)[ \t]*"
|
||||
(point-at-bol) 'move)
|
||||
(goto-char (match-end 0)))
|
||||
(point)))
|
||||
(query-words (split-string (buffer-substring beg end) "[ \t]+"))
|
||||
(query-words (split-string (buffer-substring-no-properties beg end)
|
||||
"[ \t]+"))
|
||||
query-formats
|
||||
response
|
||||
response-string
|
||||
@ -840,18 +846,17 @@ see `eudc-inline-expansion-servers'"
|
||||
((eq eudc-inline-expansion-servers 'hotlist)
|
||||
eudc-server-hotlist)
|
||||
((eq eudc-inline-expansion-servers 'server-then-hotlist)
|
||||
(cons (cons eudc-server eudc-protocol)
|
||||
(delete (cons eudc-server eudc-protocol) servers)))
|
||||
(if eudc-server
|
||||
(cons (cons eudc-server eudc-protocol)
|
||||
(delete (cons eudc-server eudc-protocol) servers))
|
||||
eudc-server-hotlist))
|
||||
((eq eudc-inline-expansion-servers 'current-server)
|
||||
(list (cons eudc-server eudc-protocol)))
|
||||
(t
|
||||
(error "Wrong value for `eudc-inline-expansion-servers': %S"
|
||||
eudc-inline-expansion-servers))))
|
||||
(list (cons eudc-server eudc-protocol)))))
|
||||
(if (and eudc-max-servers-to-query
|
||||
(> (length servers) eudc-max-servers-to-query))
|
||||
(setcdr (nthcdr (1- eudc-max-servers-to-query) servers) nil))
|
||||
|
||||
(condition-case signal
|
||||
(unwind-protect
|
||||
(progn
|
||||
(setq response
|
||||
(catch 'found
|
||||
@ -887,14 +892,15 @@ see `eudc-inline-expansion-servers'"
|
||||
|
||||
;; Process response through eudc-inline-expansion-format
|
||||
(while response
|
||||
(setq response-string (apply 'format
|
||||
(car eudc-inline-expansion-format)
|
||||
(mapcar (function
|
||||
(lambda (field)
|
||||
(or (cdr (assq field (car response)))
|
||||
"")))
|
||||
(eudc-translate-attribute-list
|
||||
(cdr eudc-inline-expansion-format)))))
|
||||
(setq response-string
|
||||
(apply 'format
|
||||
(car eudc-inline-expansion-format)
|
||||
(mapcar (function
|
||||
(lambda (field)
|
||||
(or (cdr (assq field (car response)))
|
||||
"")))
|
||||
(eudc-translate-attribute-list
|
||||
(cdr eudc-inline-expansion-format)))))
|
||||
(if (> (length response-string) 0)
|
||||
(setq response-strings
|
||||
(cons response-string response-strings)))
|
||||
@ -916,15 +922,10 @@ see `eudc-inline-expansion-servers'"
|
||||
(delete-region beg end)
|
||||
(insert (mapconcat 'identity response-strings ", ")))
|
||||
((eq eudc-multiple-match-handling-method 'abort)
|
||||
(error "There is more than one match for the query"))))
|
||||
(or (and (equal eudc-server eudc-former-server)
|
||||
(equal eudc-protocol eudc-former-protocol))
|
||||
(eudc-set-server eudc-former-server eudc-former-protocol t)))
|
||||
(error
|
||||
(or (and (equal eudc-server eudc-former-server)
|
||||
(equal eudc-protocol eudc-former-protocol))
|
||||
(eudc-set-server eudc-former-server eudc-former-protocol t))
|
||||
(signal (car signal) (cdr signal))))))
|
||||
(error "There is more than one match for the query")))))
|
||||
(or (and (equal eudc-server eudc-former-server)
|
||||
(equal eudc-protocol eudc-former-protocol))
|
||||
(eudc-set-server eudc-former-server eudc-former-protocol t)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun eudc-query-form (&optional get-fields-from-server)
|
||||
|
||||
@ -70,16 +70,17 @@
|
||||
("mail" . eudc-display-mail)
|
||||
("url" . eudc-display-url))
|
||||
'ldap)
|
||||
(eudc-protocol-set 'eudc-switch-to-server-hook
|
||||
'(eudc-ldap-check-base)
|
||||
'ldap)
|
||||
|
||||
(defun eudc-ldap-cleanup-record-simple (record)
|
||||
"Do some cleanup in a RECORD to make it suitable for EUDC."
|
||||
(mapcar
|
||||
(function
|
||||
(lambda (field)
|
||||
(cons (intern (car field))
|
||||
;; Some servers return case-sensitive names (e.g. givenName
|
||||
;; instead of givenname); downcase the field's name so that it
|
||||
;; can be matched against
|
||||
;; eudc-ldap-attributes-translation-alist.
|
||||
(cons (intern (downcase (car field)))
|
||||
(if (cdr (cdr field))
|
||||
(cdr field)
|
||||
(car (cdr field))))))
|
||||
@ -95,7 +96,7 @@
|
||||
(mapcar
|
||||
(function
|
||||
(lambda (field)
|
||||
(let ((name (intern (car field)))
|
||||
(let ((name (intern (downcase (car field))))
|
||||
(value (cdr field)))
|
||||
(if (memq name '(postaladdress registeredaddress))
|
||||
(setq value (mapcar 'eudc-filter-$ value)))
|
||||
@ -170,14 +171,16 @@ attribute names are returned. Default to `person'"
|
||||
|
||||
(defun eudc-ldap-format-query-as-rfc1558 (query)
|
||||
"Format the EUDC QUERY list as a RFC1558 LDAP search filter."
|
||||
(format "(&%s)"
|
||||
(apply 'concat
|
||||
(mapcar (lambda (item)
|
||||
(format "(%s=%s)"
|
||||
(car item)
|
||||
(eudc-ldap-escape-query-special-chars (cdr item))))
|
||||
query))))
|
||||
|
||||
(let ((formatter (lambda (item &optional wildcard)
|
||||
(format "(%s=%s)"
|
||||
(car item)
|
||||
(concat
|
||||
(eudc-ldap-escape-query-special-chars
|
||||
(cdr item)) (if wildcard "*" ""))))))
|
||||
(format "(&%s)"
|
||||
(concat
|
||||
(mapconcat formatter (butlast query) "")
|
||||
(funcall formatter (car (last query)) t)))))
|
||||
|
||||
;;}}}
|
||||
|
||||
|
||||
136
lisp/net/ldap.el
136
lisp/net/ldap.el
@ -34,6 +34,7 @@
|
||||
;;; Code:
|
||||
|
||||
(require 'custom)
|
||||
(require 'password-cache)
|
||||
|
||||
(autoload 'auth-source-search "auth-source")
|
||||
|
||||
@ -47,15 +48,13 @@
|
||||
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)
|
||||
(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)
|
||||
(integer :tag "Port number"))
|
||||
:group 'ldap)
|
||||
(integer :tag "Port number")))
|
||||
|
||||
(defcustom ldap-default-base nil
|
||||
"Default base for LDAP searches.
|
||||
@ -63,8 +62,7 @@ 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)
|
||||
(string :tag "Search base")))
|
||||
|
||||
|
||||
(defcustom ldap-host-parameters-alist nil
|
||||
@ -144,35 +142,35 @@ Valid properties include:
|
||||
:tag "Size Limit"
|
||||
:inline t
|
||||
(const :tag "Size Limit" sizelimit)
|
||||
(integer :tag "(number of records)")))))
|
||||
:group 'ldap)
|
||||
(integer :tag "(number of records)"))))))
|
||||
|
||||
(defcustom ldap-ldapsearch-prog "ldapsearch"
|
||||
"The name of the ldapsearch command line program."
|
||||
:type '(string :tag "`ldapsearch' Program")
|
||||
:group 'ldap)
|
||||
:type '(string :tag "`ldapsearch' Program"))
|
||||
|
||||
(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)
|
||||
(string :tag "Argument")))
|
||||
|
||||
(defcustom ldap-ldapsearch-password-prompt-regexp "Enter LDAP Password: "
|
||||
"A regular expression 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
|
||||
:group 'ldap)
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom ldap-default-attribute-decoder nil
|
||||
"Decoder function to use for attributes whose syntax is unknown."
|
||||
:type 'symbol
|
||||
:group 'ldap)
|
||||
: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
|
||||
:group 'ldap)
|
||||
:type 'symbol)
|
||||
|
||||
(defvar ldap-attribute-syntax-encoders
|
||||
[nil ; 1 ACI Item N
|
||||
@ -476,6 +474,47 @@ Additional search parameters can be specified through
|
||||
(mapcar 'ldap-decode-attribute 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.
|
||||
@ -531,7 +570,11 @@ an alist of attribute/value pairs."
|
||||
(passwd (or (plist-get search-plist 'passwd)
|
||||
(plist-get asfound :secret)))
|
||||
;; convert the password from a function call if needed
|
||||
(passwd (if (functionp passwd) (funcall passwd) passwd))
|
||||
(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)
|
||||
@ -550,7 +593,7 @@ an alist of attribute/value pairs."
|
||||
(sizelimit (plist-get search-plist 'sizelimit))
|
||||
(withdn (plist-get search-plist 'withdn))
|
||||
(numres 0)
|
||||
arglist dn name value record result)
|
||||
arglist dn name value record result proc)
|
||||
(if (or (null filter)
|
||||
(equal "" filter))
|
||||
(error "No search filter"))
|
||||
@ -559,7 +602,13 @@ an alist of attribute/value pairs."
|
||||
(erase-buffer)
|
||||
(if (and host
|
||||
(not (equal "" host)))
|
||||
(setq arglist (nconc arglist (list (format "-h%s" 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"))))
|
||||
@ -575,9 +624,9 @@ an alist of attribute/value pairs."
|
||||
(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)))))
|
||||
;; 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)))))
|
||||
@ -587,14 +636,43 @@ an alist of attribute/value pairs."
|
||||
(if (and sizelimit
|
||||
(not (equal "" sizelimit)))
|
||||
(setq arglist (nconc arglist (list (format "-z%s" sizelimit)))))
|
||||
(apply #'call-process ldap-ldapsearch-prog
|
||||
;; Ignore stderr, which can corrupt results
|
||||
nil (list buf nil) nil
|
||||
(append arglist ldap-ldapsearch-args filter))
|
||||
(if passwd
|
||||
(let* ((process-connection-type nil)
|
||||
(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 (eq status 0))
|
||||
;; 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 "[\t\n\f]+ " nil t)
|
||||
(while (re-search-forward (concat "[\t\n\f]+ \\|"
|
||||
ldap-ldapsearch-password-prompt-regexp)
|
||||
nil t)
|
||||
(replace-match "" nil nil))
|
||||
(goto-char (point-min))
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user