[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master ac5475d 17/17: lisp/net/{eudc, ldap}: Merge branch
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] master ac5475d 17/17: lisp/net/{eudc, ldap}: Merge branch streamline-eudc-configuration |
|
Date: |
Fri, 23 Jan 2015 22:20:37 +0000 |
branch: master
commit ac5475dacb20d240db27d56199910d8a6fcc90e8
Merge: fd62486 e56e1b9
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>
lisp/net/{eudc,ldap}: Merge branch streamline-eudc-configuration
---
doc/misc/ChangeLog | 9 +++-
doc/misc/eudc.texi | 130 +++++++++++++++++++++++++++++++++++++++++++---
lisp/ChangeLog | 85 ++++++++++++++++++++++++++++++
lisp/net/eudc-vars.el | 97 ++++++++++++++++++----------------
lisp/net/eudc.el | 71 +++++++++++++------------
lisp/net/eudcb-ldap.el | 29 ++++++-----
lisp/net/ldap.el | 136 +++++++++++++++++++++++++++++++++++++----------
7 files changed, 425 insertions(+), 132 deletions(-)
diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog
index 2baa13c..e75589f 100644
--- a/doc/misc/ChangeLog
+++ b/doc/misc/ChangeLog
@@ -1,3 +1,8 @@
+2015-01-23 Thomas Fitzsimmons <address@hidden>
+
+ * eudc.texi (LDAP Configuration): Rename from LDAP Requirements
+ and provide configuration examples.
+
2015-01-17 Stefan Monnier <address@hidden>
* eieio.texi (Slot Options): Document :protection as unsupported.
@@ -28,8 +33,8 @@
2014-12-18 Eric Abrahamsen <address@hidden>
- * 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 <address@hidden>
diff --git a/doc/misc/eudc.texi b/doc/misc/eudc.texi
index b5a4e3a..9757c82 100644
--- a/doc/misc/eudc.texi
+++ b/doc/misc/eudc.texi
@@ -137,7 +137,7 @@ location, address@hidden 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
address@hidden LDAP Requirements
address@hidden LDAP Requirements
address@hidden LDAP Configuration
address@hidden LDAP Configuration
-LDAP support is added by means of @file{ldap.el}, which is part of Emacs.
address@hidden needs an external command line utility named
address@hidden, 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
address@hidden, 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
address@hidden,dc=example,dc=com} and the host name
address@hidden, 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
address@hidden
+
+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:
+
address@hidden
+To: * Smith
address@hidden example
+
+will return all LDAP entries with surnames that begin with
address@hidden In every LDAP query it makes, EUDC implicitly appends
+the wildcard character to the end of the last word.
+
address@hidden Emacs-only Configuration
+
+Emacs can pass most required configuration options via the
address@hidden command-line. One exception is certificate
+configuration for LDAP-over-SSL, which must be specified in
address@hidden/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:
+
address@hidden
+TLS_CACERTDIR /etc/openldap/certs
address@hidden example
+
+In @file{.emacs}, these expressions suffice to configure EUDC for
+LDAP:
+
address@hidden
+(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)))
address@hidden 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
address@hidden is nil. You can customize
address@hidden to control the duration for which the
+password is cached. If you want to clear the cache, call
address@hidden
+
address@hidden External Configuration
+
+Your system may already be configured for a default LDAP server. For
+example, @file{/etc/openldap/ldap.conf} might contain:
+
address@hidden
+BASE ou=people,dc=example,dc=com
+URI ldaps://directory.example.com
+TLS_CACERTDIR /etc/openldap/certs
address@hidden 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:
+
address@hidden
+machine ldaps://directory.example.com binddn example\emacsuser password s3cr3t
address@hidden example
+
+Then in the @file{.emacs} init file, these expressions suffice to
+configure EUDC for LDAP:
+
address@hidden
+(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)))
address@hidden 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
address@hidden/etc/openldap/ldap.conf}.
+
+The @file{~/.authinfo.gpg} line becomes:
+
address@hidden
+binddn example\emacsuser password s3cr3t
address@hidden example
+
+and the @file{.emacs} expressions become:
+
address@hidden
+(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)))
address@hidden lisp
@node Usage
@chapter Usage
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index ed4e1ab..15518a7 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,88 @@
+2015-01-23 Thomas Fitzsimmons <address@hidden>
+
+ * net/ldap.el (ldap-search-internal): Mention binddn in invalid
+ credentials error message.
+
+2015-01-23 Thomas Fitzsimmons <address@hidden>
+
+ * net/ldap.el (ldap-password-read): Validate password before
+ caching it.
+ (ldap-search-internal): Handle ldapsearch error conditions.
+
+2015-01-23 Thomas Fitzsimmons <address@hidden>
+
+ * net/ldap.el (ldap-password-read): Handle password-cache being nil.
+
+2015-01-23 Thomas Fitzsimmons <address@hidden>
+
+ * net/eudc.el (eudc-expand-inline): Always restore former server
+ and protocol.
+
+2015-01-23 Thomas Fitzsimmons <address@hidden>
+
+ * 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 <address@hidden>
+
+ * 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 <address@hidden>
+
+ * 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 <address@hidden>
+
+ * 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 <address@hidden>
+
+ * 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 <address@hidden>
+
+ * net/eudc-vars.el (eudc-expansion-overwrites-query):
+ Change default to nil.
+
+2015-01-23 Thomas Fitzsimmons <address@hidden>
+
+ * net/eudc.el (eudc-expand-inline): Ignore text properties of
+ string-to-expand.
+
+2015-01-23 Thomas Fitzsimmons <address@hidden>
+
+ * net/eudc-vars.el (eudc-inline-expansion-format): Default to a
+ format that includes first name and surname.
+
+2015-01-23 Thomas Fitzsimmons <address@hidden>
+
+ * net/eudc-vars.el (eudc-inline-query-format): Change default to
+ query email and first name instead of surname.
+
+2015-01-23 Thomas Fitzsimmons <address@hidden>
+
+ * net/ldap.el (ldap-search-internal): Support new-style LDAP URIs.
+
+2015-01-23 Thomas Fitzsimmons <address@hidden>
+
+ * 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 <address@hidden>
* emacs-lisp/cl-generic.el (cl-no-primary-method): New fun and error.
diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el
index 6bc0337..29ddf61 100644
--- a/lisp/net/eudc-vars.el
+++ b/lisp/net/eudc-vars.el
@@ -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)
;;}}}
diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el
index 0f2fc0b..4dd8097 100644
--- a/lisp/net/eudc.el
+++ b/lisp/net/eudc.el
@@ -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)
diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el
index 4c9b249..92972c5 100644
--- a/lisp/net/eudcb-ldap.el
+++ b/lisp/net/eudcb-ldap.el
@@ -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)))))
;;}}}
diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
index eb1b758..a77fc3c 100644
--- a/lisp/net/ldap.el
+++ b/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))
- [Emacs-diffs] master 6a3a3b0 09/17: Downcase field names in LDAP results, (continued)
- [Emacs-diffs] master 6a3a3b0 09/17: Downcase field names in LDAP results, Stefan Monnier, 2015/01/23
- [Emacs-diffs] master 87ff9ae 07/17: Add password-cache support to ldap.el, Stefan Monnier, 2015/01/23
- [Emacs-diffs] master ea0ea90 08/17: ldap-search-internal: Send password to ldapsearch through a pipe, Stefan Monnier, 2015/01/23
- [Emacs-diffs] master 1e1f5b9 10/17: Append LDAP wildcard character to end of search string, Stefan Monnier, 2015/01/23
- [Emacs-diffs] master 81d0909 12/17: Restore former eudc-expand-inline settings after a nonlocal exit, Stefan Monnier, 2015/01/23
- [Emacs-diffs] master 7860227 11/17: Do not ask the user for an LDAP base if a default has been provided, Stefan Monnier, 2015/01/23
- [Emacs-diffs] master 9006ccd 13/17: Handle nil password-cache in ldap-password-read, Stefan Monnier, 2015/01/23
- [Emacs-diffs] master 4a77d69 14/17: ldap-password-read: Validate password before caching it, Stefan Monnier, 2015/01/23
- [Emacs-diffs] master e56e1b9 16/17: Mention binddn in LDAP credentials error message, Stefan Monnier, 2015/01/23
- [Emacs-diffs] master a6d4651 15/17: Update LDAP configuration section of EUDC manual, Stefan Monnier, 2015/01/23
- [Emacs-diffs] master ac5475d 17/17: lisp/net/{eudc, ldap}: Merge branch streamline-eudc-configuration,
Stefan Monnier <=