Commit ac5475da authored by Stefan Monnier's avatar Stefan Monnier
Browse files

lisp/net/{eudc,ldap}: Merge branch streamline-eudc-configuration

parents fd62486e e56e1b92
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
......
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))
(cond
((eq eudc-inline-expansion-servers 'current-server)
(or eudc-server
(call-interactively 'eudc-set-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)
(if eudc-server
(cons (cons eudc-server eudc-protocol)
(delete (cons eudc-server eudc-protocol) servers)))
(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,7 +892,8 @@ see `eudc-inline-expansion-servers'"
;; Process response through eudc-inline-expansion-format
(while response
(setq response-string (apply 'format
(setq response-string
(apply 'format
(car eudc-inline-expansion-format)
(mapcar (function
(lambda (field)
......@@ -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
(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))
(signal (car signal) (cdr signal))))))
(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)
(let ((formatter (lambda (item &optional wildcard)
(format "(%s=%s)"
(car item)
(eudc-ldap-escape-query-special-chars (cdr item))))
query))))
(concat