From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Thomas Fitzsimmons Newsgroups: gmane.emacs.bugs Subject: bug#16322: Acknowledgement (24.3; [PATCH] Streamline EUDC LDAP configuration) Date: Thu, 13 Nov 2014 12:11:59 -0500 Message-ID: References: <83mw7vkvf1.fsf@gnu.org> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1415898805 24239 80.91.229.3 (13 Nov 2014 17:13:25 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Thu, 13 Nov 2014 17:13:25 +0000 (UTC) Cc: 16322@debbugs.gnu.org To: Eli Zaretskii Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Thu Nov 13 18:13:19 2014 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1XoxxN-0007UR-8r for geb-bug-gnu-emacs@m.gmane.org; Thu, 13 Nov 2014 18:13:17 +0100 Original-Received: from localhost ([::1]:33018 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XoxxM-0005nH-QS for geb-bug-gnu-emacs@m.gmane.org; Thu, 13 Nov 2014 12:13:16 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:36822) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XoxxD-0005m6-70 for bug-gnu-emacs@gnu.org; Thu, 13 Nov 2014 12:13:12 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Xoxx8-0005fu-Dj for bug-gnu-emacs@gnu.org; Thu, 13 Nov 2014 12:13:07 -0500 Original-Received: from debbugs.gnu.org ([140.186.70.43]:34166) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Xoxx8-0005fp-9w for bug-gnu-emacs@gnu.org; Thu, 13 Nov 2014 12:13:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.80) (envelope-from ) id 1Xoxx7-0002Rp-PF for bug-gnu-emacs@gnu.org; Thu, 13 Nov 2014 12:13:01 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Thomas Fitzsimmons Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 13 Nov 2014 17:13:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 16322 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 16322-submit@debbugs.gnu.org id=B16322.14158987379349 (code B ref 16322); Thu, 13 Nov 2014 17:13:01 +0000 Original-Received: (at 16322) by debbugs.gnu.org; 13 Nov 2014 17:12:17 +0000 Original-Received: from localhost ([127.0.0.1]:59612 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1XoxwL-0002Qg-8V for submit@debbugs.gnu.org; Thu, 13 Nov 2014 12:12:16 -0500 Original-Received: from mail-ig0-f177.google.com ([209.85.213.177]:45842) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1XoxwF-0002QS-SX for 16322@debbugs.gnu.org; Thu, 13 Nov 2014 12:12:11 -0500 Original-Received: by mail-ig0-f177.google.com with SMTP id hl2so31127igb.10 for <16322@debbugs.gnu.org>; Thu, 13 Nov 2014 09:12:07 -0800 (PST) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20130820; h=x-gm-message-state:from:to:cc:subject:references:date:in-reply-to :message-id:user-agent:mime-version:content-type; bh=ApLpNnsYILF3aDw6QgocS/msjEX7xVPvGclOHcDwLoA=; b=TToX3tiHkgWgaYjQ+JRqqASZiaX5G5q3kUKa28OMIsrT2SaY0Y7bzVGwTDjsS4/xZ0 VLVyPYJc3kRZLEwoba5lEWAt1onrTeM+0u3gqMENYEjN3l0IVvaalMZZxvWIDdfkVy6b W3r0Ee6PJT/ZqAk8OQ3CnPTgfLKvQjPjOlh6xvxn2n0ihqay92bFdH6b6fUttWkJeGuL UKRKiCI1yQEX0ZgrWXiOZcLdvdEhnLjy5G1A5oHyzKUfTTDbNKd1LBLqr6YQTlYItZkw hgjfKMOzKXP+vUOYHncK9gLBBQuBZ0zgMUNCDM+7sAoq+TENv/duEPc1i2NdCiAfAvYY DNCg== X-Gm-Message-State: ALoCoQmPguISE4LkPiz9lkVvXyX6AdMMdCH9oFv64ntjGnxCTO9CZJd4T80EwyLNRXqIIXQgdYTE X-Received: by 10.107.148.132 with SMTP id w126mr4167544iod.28.1415898726447; Thu, 13 Nov 2014 09:12:06 -0800 (PST) Original-Received: from hp-dv5t (69-165-165-189.dsl.teksavvy.com. [69.165.165.189]) by mx.google.com with ESMTPSA id 137sm13101302iof.2.2014.11.13.09.12.04 for (version=TLSv1.2 cipher=RC4-SHA bits=128/128); Thu, 13 Nov 2014 09:12:05 -0800 (PST) In-Reply-To: <83mw7vkvf1.fsf@gnu.org> (Eli Zaretskii's message of "Thu, 13 Nov 2014 16:49:22 +0200") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.3.50 (gnu/linux) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.15 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x X-Received-From: 140.186.70.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:95933 --=-=-= Content-Type: text/plain Eli Zaretskii writes: >> From: Thomas Fitzsimmons >> Date: Thu, 13 Nov 2014 03:50:46 -0500 >> >> Now that the Emacs git repository is live, I've updated this patch set: >> >> https://github.com/fitzsim/emacs/tree/streamline-eudc-configuration > > Thanks. But this is not a patchset, it's a cloned repository with > changes, isn't it? Can you send just the patches? Sure. Just for reference, the new branch based on master is: https://github.com/fitzsim/emacs/tree/streamline-eudc-configuration-2 >> I rebased onto 24.4, did a clean build and confirmed the functionality >> works in an emacs -Q session with minimal configuration. > > If this is accepted, it will not be for the emacs-24 branch, so please > generate the changes relative to the master branch. I rebased and retested on master. Attached is the patchset generated by "git format-patch". Thomas --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Change-eudc-server-hotlist-from-a-defvar-to-a-defcus.patch >From 15de53922d2ea7d40b0dad6a0b6ccf60845fa84c Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Thu, 13 Nov 2014 00:50:01 -0500 Subject: [PATCH 01/16] Change eudc-server-hotlist from a defvar to a defcustom * 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. --- lisp/ChangeLog | 10 ++++++++++ lisp/net/eudc-vars.el | 25 ++++++++++++++++++++++++- lisp/net/eudc.el | 35 ++++++++++++++++++++--------------- 3 files changed, 54 insertions(+), 16 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index e3baa30..cfe24b4 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,13 @@ +2014-11-13 Thomas Fitzsimmons + + * 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. + 2014-11-13 Michael Albinus * vc/vc-hg.el (vc-hg-state): Disable pager. (Bug#18940) diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el index 419b764..54995a3 100644 --- a/lisp/net/eudc-vars.el +++ b/lisp/net/eudc-vars.el @@ -41,7 +41,10 @@ "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)." +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)) :group 'eudc) @@ -49,6 +52,26 @@ server resides on your computer (BBDB backend)." ;; 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)))) + :group 'eudc) + (defvar eudc-supported-protocols nil "Protocols currently supported by EUDC. This variable is updated when protocol-specific libraries diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index bf67e4b..e038b28 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)) @@ -812,12 +809,21 @@ 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]*" @@ -840,13 +846,12 @@ 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)) -- 1.8.1.4 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-Support-new-style-LDAP-URIs-in-ldap-search-internal.patch >From b3797956bfbebd968498ec0e4664673ccc2100ed Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Thu, 13 Nov 2014 00:59:12 -0500 Subject: [PATCH 02/16] Support new-style LDAP URIs in ldap-search-internal * net/ldap.el (ldap-search-internal): Support new-style LDAP URIs. --- lisp/ChangeLog | 4 ++++ lisp/net/ldap.el | 8 +++++++- 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index cfe24b4..e45ead7 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,9 @@ 2014-11-13 Thomas Fitzsimmons + * net/ldap.el (ldap-search-internal): Support new-style LDAP URIs. + +2014-11-13 Thomas Fitzsimmons + * net/eudc-vars.el (eudc-server): Adjust docstring to mention eudc-server-hotlist. (eudc-server-hotlist): Move from eudc.el and make defcustom. diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index 10ce7a7..2b5b2fb 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -559,7 +559,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")))) -- 1.8.1.4 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-Improve-eudc-inline-query-format-s-default-value.patch >From 835c7f9fec3d2ee6d73fef2fec3d21b8c5752d49 Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Thu, 13 Nov 2014 01:06:13 -0500 Subject: [PATCH 03/16] Improve eudc-inline-query-format's default value * net/eudc-vars.el (eudc-inline-query-format): Change default to query email and first name instead of surname. --- lisp/ChangeLog | 5 +++++ lisp/net/eudc-vars.el | 3 ++- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index e45ead7..08e20f9 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,10 @@ 2014-11-13 Thomas Fitzsimmons + * net/eudc-vars.el (eudc-inline-query-format): Change default to + query email and first name instead of surname. + +2014-11-13 Thomas Fitzsimmons + * net/ldap.el (ldap-search-internal): Support new-style LDAP URIs. 2014-11-13 Thomas Fitzsimmons diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el index 54995a3..06f63eb 100644 --- a/lisp/net/eudc-vars.el +++ b/lisp/net/eudc-vars.el @@ -156,7 +156,8 @@ different values." (const :menu-tag "Duplicate" duplicate))))) :group 'eudc) -(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 -- 1.8.1.4 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0004-Improve-eudc-inline-expansion-format-s-default-value.patch >From b9a508618c5c2abbd2beef6f72e31d2a4f22c3b5 Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Thu, 13 Nov 2014 01:10:10 -0500 Subject: [PATCH 04/16] Improve eudc-inline-expansion-format's default value * net/eudc-vars.el (eudc-inline-expansion-format): Default to a format that includes first name and surname. --- lisp/ChangeLog | 5 +++++ lisp/net/eudc-vars.el | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 08e20f9..81dc8ba 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,10 @@ 2014-11-13 Thomas Fitzsimmons + * net/eudc-vars.el (eudc-inline-expansion-format): Default to a + format that includes first name and surname. + +2014-11-13 Thomas Fitzsimmons + * net/eudc-vars.el (eudc-inline-query-format): Change default to query email and first name instead of surname. diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el index 06f63eb..2affe7b 100644 --- a/lisp/net/eudc-vars.el +++ b/lisp/net/eudc-vars.el @@ -191,7 +191,7 @@ must be set in a protocol/server-local fashion, see `eudc-server-set' and :type 'boolean :group 'eudc) -(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 -- 1.8.1.4 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0005-Ignore-text-properties-in-eudc-expand-inline.patch >From 4e4e853959e891429d8a408be09fc48f07bf8b0e Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Thu, 13 Nov 2014 01:13:34 -0500 Subject: [PATCH 05/16] Ignore text properties in eudc-expand-inline * net/eudc.el (eudc-expand-inline): Ignore text properties of string-to-expand. --- lisp/ChangeLog | 5 +++++ lisp/net/eudc.el | 3 ++- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 81dc8ba..bdf8eae 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,10 @@ 2014-11-13 Thomas Fitzsimmons + * net/eudc.el (eudc-expand-inline): Ignore text properties of + string-to-expand. + +2014-11-13 Thomas Fitzsimmons + * net/eudc-vars.el (eudc-inline-expansion-format): Default to a format that includes first name and surname. diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index e038b28..54a41f0 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -830,7 +830,8 @@ see `eudc-inline-expansion-servers'" (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 -- 1.8.1.4 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0006-Change-eudc-expansion-overwrites-query-default-to-ni.patch >From f974ce1672c44542be1f485ee8a79543e9f5d978 Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Thu, 13 Nov 2014 01:17:56 -0500 Subject: [PATCH 06/16] Change eudc-expansion-overwrites-query default to nil * net/eudc-vars.el (eudc-expansion-overwrites-query): Change default to nil. --- lisp/ChangeLog | 5 +++++ lisp/net/eudc-vars.el | 4 +++- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index bdf8eae..d115ad7 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,10 @@ 2014-11-13 Thomas Fitzsimmons + * net/eudc-vars.el (eudc-expansion-overwrites-query): Change + default to nil. + +2014-11-13 Thomas Fitzsimmons + * net/eudc.el (eudc-expand-inline): Ignore text properties of string-to-expand. diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el index 2affe7b..b3a0bf9 100644 --- a/lisp/net/eudc-vars.el +++ b/lisp/net/eudc-vars.el @@ -186,7 +186,9 @@ must be set in a protocol/server-local fashion, see `eudc-server-set' and (symbol :menu-tag "Other" :tag "Attribute name")))) :group 'eudc) -(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) -- 1.8.1.4 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0007-Add-password-cache-support-to-ldap.el.patch >From c1b99db69c91e58a3b7f319c9aaccec0ebbe1863 Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Thu, 13 Nov 2014 01:23:54 -0500 Subject: [PATCH 07/16] Add password-cache support to ldap.el * 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. --- lisp/ChangeLog | 7 +++++++ lisp/net/ldap.el | 21 ++++++++++++++++++++- 2 files changed, 27 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d115ad7..7c62de5 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,12 @@ 2014-11-13 Thomas Fitzsimmons + * 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. + +2014-11-13 Thomas Fitzsimmons + * net/eudc-vars.el (eudc-expansion-overwrites-query): Change default to nil. diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index 2b5b2fb..113a9bc 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") @@ -476,6 +477,20 @@ 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 and the password is cached. The cache can be cleared +with `password-reset`." + ;; Add ldap: namespace to allow empty string for default host. + (let ((host-key (concat "ldap:" host))) + (when (not (password-in-cache-p host-key)) + (password-cache-add host-key (password-read + (format "Enter LDAP Password%s: " + (if (equal host "") + "" + (format " for %s" host)))))) + (password-read-from-cache host-key))) (defun ldap-search-internal (search-plist) "Perform a search on a LDAP server. @@ -531,7 +546,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) -- 1.8.1.4 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0008-ldap-search-internal-Send-password-to-ldapsearch-thr.patch >From 20f9ddf5ed29ef76569e7e2362fae62950b10fc0 Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Thu, 13 Nov 2014 01:27:14 -0500 Subject: [PATCH 08/16] ldap-search-internal: Send password to ldapsearch through a pipe * 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. --- lisp/ChangeLog | 6 ++++++ lisp/net/ldap.el | 42 +++++++++++++++++++++++++++++++++--------- 2 files changed, 39 insertions(+), 9 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7c62de5..43760f2 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,11 @@ 2014-11-13 Thomas Fitzsimmons + * 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. + +2014-11-13 Thomas Fitzsimmons + * net/ldap.el: Require password-cache. (ldap-password-read): New function. (ldap-search-internal): Call ldap-password-read when it is diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index 113a9bc..32e403a 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -159,6 +159,12 @@ Valid properties include: (string :tag "Argument")) :group 'ldap) +(defcustom ldap-ldapsearch-password-prompt-regexp "Enter LDAP Password: " + "A regular expression used to recognize the `ldapsearch' +program's password prompt." + :type 'regexp + :group 'ldap) + (defcustom ldap-ignore-attribute-codings nil "If non-nil, do not encode/decode LDAP attribute values." :type 'boolean @@ -569,7 +575,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")) @@ -600,9 +606,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))))) @@ -612,14 +618,32 @@ 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 (apply #'start-process "ldapsearch" buf + ldap-ldapsearch-prog + (append arglist ldap-ldapsearch-args + filter)))) + (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))) + (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)) -- 1.8.1.4 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0009-Downcase-field-names-in-LDAP-results.patch >From aba4ff14624d7c99c76b18fa065aa0ae458f621b Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Thu, 13 Nov 2014 01:30:53 -0500 Subject: [PATCH 09/16] Downcase field names in LDAP results * net/eudcb-ldap.el (eudc-ldap-cleanup-record-simple): Downcase field names of LDAP results. (eudc-ldap-cleanup-record-filtering-addresses): Likewise. --- lisp/ChangeLog | 6 ++++++ lisp/net/eudcb-ldap.el | 8 ++++++-- 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 43760f2..3d41760 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,11 @@ 2014-11-13 Thomas Fitzsimmons + * net/eudcb-ldap.el (eudc-ldap-cleanup-record-simple): Downcase + field names of LDAP results. + (eudc-ldap-cleanup-record-filtering-addresses): Likewise. + +2014-11-13 Thomas Fitzsimmons + * 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. diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el index 6c806d7..1b01d21 100644 --- a/lisp/net/eudcb-ldap.el +++ b/lisp/net/eudcb-ldap.el @@ -79,7 +79,11 @@ (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 +99,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))) -- 1.8.1.4 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0010-Append-LDAP-wildcard-character-to-end-of-search-stri.patch >From e2639d7cb42118a5b70ed619a774a89e376d36e2 Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Thu, 13 Nov 2014 01:34:35 -0500 Subject: [PATCH 10/16] Append LDAP wildcard character to end of search string * 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. --- lisp/ChangeLog | 8 ++++++++ lisp/net/eudc.el | 1 - lisp/net/eudcb-ldap.el | 18 ++++++++++-------- 3 files changed, 18 insertions(+), 9 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3d41760..1ef74a6 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,13 @@ 2014-11-13 Thomas Fitzsimmons + * 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. + +2014-11-13 Thomas Fitzsimmons + * net/eudcb-ldap.el (eudc-ldap-cleanup-record-simple): Downcase field names of LDAP results. (eudc-ldap-cleanup-record-filtering-addresses): Likewise. diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index 54a41f0..2a21581 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -763,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) diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el index 1b01d21..e43e570 100644 --- a/lisp/net/eudcb-ldap.el +++ b/lisp/net/eudcb-ldap.el @@ -174,14 +174,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))))) ;;}}} -- 1.8.1.4 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0011-Do-not-ask-the-user-for-an-LDAP-base-if-a-default-ha.patch >From 0c8580ec3746731bf8e7b01b63f8cb800f42d763 Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Thu, 13 Nov 2014 02:21:23 -0500 Subject: [PATCH 11/16] Do not ask the user for an LDAP base if a default has been provided * net/eudcb-ldap.el: Don't nag the user in case a default base is provided by the LDAP system configuration file. --- lisp/ChangeLog | 5 +++++ lisp/net/eudcb-ldap.el | 3 --- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 1ef74a6..6d48bad 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,10 @@ 2014-11-13 Thomas Fitzsimmons + * net/eudcb-ldap.el: Don't nag the user in case a default base is + provided by the LDAP system configuration file. + +2014-11-13 Thomas Fitzsimmons + * net/eudc.el (eudc-format-query): Preserve the eudc-inline-query-format ordering of attributes in the returned list. diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el index e43e570..6d0c208 100644 --- a/lisp/net/eudcb-ldap.el +++ b/lisp/net/eudcb-ldap.el @@ -70,9 +70,6 @@ ("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." -- 1.8.1.4 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0012-Restore-former-eudc-expand-inline-settings-after-a-n.patch >From 29834672b5931226fc5cb2ff7beb707fb980f190 Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Thu, 13 Nov 2014 02:35:54 -0500 Subject: [PATCH 12/16] Restore former eudc-expand-inline settings after a nonlocal exit * net/eudc.el (eudc-expand-inline): Always restore former server and protocol. --- lisp/ChangeLog | 5 ++ lisp/net/eudc.el | 146 +++++++++++++++++++++++++++---------------------------- 2 files changed, 77 insertions(+), 74 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6d48bad..407c6cd 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,10 @@ 2014-11-13 Thomas Fitzsimmons + * net/eudc.el (eudc-expand-inline): Always restore former server + and protocol. + +2014-11-13 Thomas Fitzsimmons + * net/eudcb-ldap.el: Don't nag the user in case a default base is provided by the LDAP system configuration file. diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index 2a21581..352ce74 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -856,80 +856,78 @@ see `eudc-inline-expansion-servers'" (> (length servers) eudc-max-servers-to-query)) (setcdr (nthcdr (1- eudc-max-servers-to-query) servers) nil)) - (condition-case signal - (progn - (setq response - (catch 'found - ;; Loop on the servers - (while servers - (eudc-set-server (eudc-caar servers) (eudc-cdar servers) t) - - ;; Determine which formats apply in the query-format list - (setq query-formats - (or - (eudc-extract-n-word-formats eudc-inline-query-format - (length query-words)) - (if (null eudc-protocol-has-default-query-attributes) - '(name)))) - - ;; Loop on query-formats - (while query-formats - (setq response - (eudc-query - (eudc-format-query query-words (car query-formats)) - (eudc-translate-attribute-list - (cdr eudc-inline-expansion-format)))) - (if response - (throw 'found response)) - (setq query-formats (cdr query-formats))) - (setq servers (cdr servers))) - ;; No more servers to try... no match found - nil)) - - - (if (null response) - (error "No match") - - ;; 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))))) - (if (> (length response-string) 0) - (setq response-strings - (cons response-string response-strings))) - (setq response (cdr response))) - - (if (or - (and replace (not eudc-expansion-overwrites-query)) - (and (not replace) eudc-expansion-overwrites-query)) - (kill-ring-save beg end)) - (cond - ((or (= (length response-strings) 1) - (null eudc-multiple-match-handling-method) - (eq eudc-multiple-match-handling-method 'first)) - (delete-region beg end) - (insert (car response-strings))) - ((eq eudc-multiple-match-handling-method 'select) - (eudc-select response-strings beg end)) - ((eq eudc-multiple-match-handling-method 'all) - (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)))))) + (unwind-protect + (condition-case signal + (progn + (setq response + (catch 'found + ;; Loop on the servers + (while servers + (eudc-set-server (eudc-caar servers) (eudc-cdar servers) t) + + ;; Determine which formats apply in the query-format list + (setq query-formats + (or + (eudc-extract-n-word-formats eudc-inline-query-format + (length query-words)) + (if (null eudc-protocol-has-default-query-attributes) + '(name)))) + + ;; Loop on query-formats + (while query-formats + (setq response + (eudc-query + (eudc-format-query query-words (car query-formats)) + (eudc-translate-attribute-list + (cdr eudc-inline-expansion-format)))) + (if response + (throw 'found response)) + (setq query-formats (cdr query-formats))) + (setq servers (cdr servers))) + ;; No more servers to try... no match found + nil)) + + + (if (null response) + (error "No match") + + ;; 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))))) + (if (> (length response-string) 0) + (setq response-strings + (cons response-string response-strings))) + (setq response (cdr response))) + + (if (or + (and replace (not eudc-expansion-overwrites-query)) + (and (not replace) eudc-expansion-overwrites-query)) + (kill-ring-save beg end)) + (cond + ((or (= (length response-strings) 1) + (null eudc-multiple-match-handling-method) + (eq eudc-multiple-match-handling-method 'first)) + (delete-region beg end) + (insert (car response-strings))) + ((eq eudc-multiple-match-handling-method 'select) + (eudc-select response-strings beg end)) + ((eq eudc-multiple-match-handling-method 'all) + (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"))))) + (error + (signal (car signal) (cdr signal)))) + (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) -- 1.8.1.4 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0013-Handle-nil-password-cache-in-ldap-password-read.patch >From c3eebe9a36afaf7c919abdd7da7b1465cbcfbaa5 Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Thu, 13 Nov 2014 02:43:36 -0500 Subject: [PATCH 13/16] Handle nil password-cache in ldap-password-read * net/ldap.el (ldap-password-read): Handle password-cache being nil. --- lisp/ChangeLog | 5 +++++ lisp/net/ldap.el | 20 ++++++++++---------- 2 files changed, 15 insertions(+), 10 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 407c6cd..2b50996 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,10 @@ 2014-11-13 Thomas Fitzsimmons + * net/ldap.el (ldap-password-read): Handle password-cache being + nil. + +2014-11-13 Thomas Fitzsimmons + * net/eudc.el (eudc-expand-inline): Always restore former server and protocol. diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index 32e403a..477c21b 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -487,16 +487,16 @@ Additional search parameters can be specified through "Read LDAP password for HOST. If the password is cached, it is read from the cache, otherwise the user is prompted for the password and the password is cached. The cache can be cleared -with `password-reset`." - ;; Add ldap: namespace to allow empty string for default host. - (let ((host-key (concat "ldap:" host))) - (when (not (password-in-cache-p host-key)) - (password-cache-add host-key (password-read - (format "Enter LDAP Password%s: " - (if (equal host "") - "" - (format " for %s" host)))))) - (password-read-from-cache host-key))) +with the `password-reset' function and the +`password-cache-expiry' variable controls how long the password +is cached for." + (password-read-and-add + (format "Enter LDAP Password%s: " + (if (equal host "") + "" + (format " for %s" host))) + ;; Add ldap: namespace to allow empty string for default host. + (concat "ldap:" host))) (defun ldap-search-internal (search-plist) "Perform a search on a LDAP server. -- 1.8.1.4 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0014-ldap-password-read-Validate-password-before-caching-.patch >From c2415db8cb1f655cd58d661ab0ca192e87ae7017 Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Thu, 13 Nov 2014 02:46:04 -0500 Subject: [PATCH 14/16] ldap-password-read: Validate password before caching it * net/ldap.el (ldap-password-read): Validate password before caching it. (ldap-search-internal): Handle ldapsearch error conditions. --- lisp/ChangeLog | 6 ++++++ lisp/net/ldap.el | 65 ++++++++++++++++++++++++++++++++++++++++++++------------ 2 files changed, 57 insertions(+), 14 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2b50996..46e562f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,11 @@ 2014-11-13 Thomas Fitzsimmons + * net/ldap.el (ldap-password-read): Validate password before + caching it. + (ldap-search-internal): Handle ldapsearch error conditions. + +2014-11-13 Thomas Fitzsimmons + * net/ldap.el (ldap-password-read): Handle password-cache being nil. diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index 477c21b..dfa66f1 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -486,17 +486,44 @@ Additional search parameters can be specified through (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 and the password is cached. The cache can be cleared -with the `password-reset' function and the -`password-cache-expiry' variable controls how long the password -is cached for." - (password-read-and-add - (format "Enter LDAP Password%s: " - (if (equal host "") - "" - (format " for %s" host))) - ;; Add ldap: namespace to allow empty string for default host. - (concat "ldap:" host))) +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. @@ -620,10 +647,11 @@ an alist of attribute/value pairs." (setq arglist (nconc arglist (list (format "-z%s" sizelimit))))) (if passwd (let* ((process-connection-type nil) + (proc-args (append arglist ldap-ldapsearch-args + filter)) (proc (apply #'start-process "ldapsearch" buf ldap-ldapsearch-prog - (append arglist ldap-ldapsearch-args - filter)))) + proc-args))) (while (null (progn (goto-char (point-min)) (re-search-forward @@ -633,7 +661,16 @@ an alist of attribute/value pairs." (process-send-string proc passwd) (process-send-string proc "\n") (while (not (memq (process-status proc) '(exit signal))) - (sit-for 0.1))) + (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 "Incorrect LDAP password") + (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 -- 1.8.1.4 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0015-Update-LDAP-configuration-section-of-EUDC-manual.patch >From b906e3f0318cbb06932fd531406d60ee79db152b Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Thu, 13 Nov 2014 02:47:49 -0500 Subject: [PATCH 15/16] Update LDAP configuration section of EUDC manual * eudc.texi (LDAP Configuration): Rename from LDAP Requirements and provide configuration examples. --- doc/misc/ChangeLog | 5 +++ doc/misc/eudc.texi | 130 +++++++++++++++++++++++++++++++++++++++++++++++++---- 2 files changed, 127 insertions(+), 8 deletions(-) diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index fcf81b0..fc296de 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,8 @@ +2014-11-13 Thomas Fitzsimmons + + * eudc.texi (LDAP Configuration): Rename from LDAP Requirements + and provide configuration examples. + 2014-11-10 Lars Magne Ingebrigtsen * eww.texi (Basics): Document `eww-readable'. diff --git a/doc/misc/eudc.texi b/doc/misc/eudc.texi index 086e741..fa665d6 100644 --- a/doc/misc/eudc.texi +++ b/doc/misc/eudc.texi @@ -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.8.1.4 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0016-Mention-binddn-in-LDAP-credentials-error-message.patch >From 9734b1416cbb5a71af02c1520adf28fa6327a51b Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Thu, 13 Nov 2014 02:54:13 -0500 Subject: [PATCH 16/16] Mention binddn in LDAP credentials error message * net/ldap.el (ldap-search-internal): Mention binddn in invalid credentials error message. --- lisp/ChangeLog | 5 +++++ lisp/net/ldap.el | 3 ++- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 46e562f..be61283 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,10 @@ 2014-11-13 Thomas Fitzsimmons + * net/ldap.el (ldap-search-internal): Mention binddn in invalid + credentials error message. + +2014-11-13 Thomas Fitzsimmons + * net/ldap.el (ldap-password-read): Validate password before caching it. (ldap-search-internal): Handle ldapsearch error conditions. diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index dfa66f1..fb425b3 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -667,7 +667,8 @@ an alist of attribute/value pairs." ;; Handle invalid credentials exit status specially ;; for ldap-password-read. (if (eq status 49) - (error "Incorrect LDAP password") + (error (concat "Incorrect LDAP password or" + " bind distinguished name (binddn)")) (error "Failed ldapsearch invocation: %s \"%s\"" ldap-ldapsearch-prog (mapconcat 'identity proc-args "\" \"")))))) -- 1.8.1.4 --=-=-=--