From: Thomas Fitzsimmons <fitzsim@fitzsim.org>
Date: Fri, 6 Mar 2015 02:53:37 +0000 (-0500)
Subject: Fix EUDC LDAP duplicate mail handling
X-Git-Tag: emacs-25.0.90~2564^2~213
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=bfebebbc72c6a6ea375c6e8ed7f8641b25439770;p=emacs.git

Fix EUDC LDAP duplicate mail handling

Fixes: debbugs:17720

* net/eudcb-ldap.el (eudc-ldap-cleanup-record-simple): Mark as
obsolete.
(eudc-ldap-cleanup-record-filtering-addresses): Add docstring.
Don't clean up postal addresses if ldap-ignore-attribute-codings
is set.  Combine mail addresses into one field. (Bug#17720)
(eudc-ldap-simple-query-internal): Call
eudc-ldap-cleanup-record-filtering-addresses instead of
eudc-ldap-cleanup-record-simple.
(eudc-ldap-get-field-list): Likewise.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 0f905e65711..edea71cda52 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,15 @@
+2015-03-06  Thomas Fitzsimmons  <fitzsim@fitzsim.org>
+
+	* net/eudcb-ldap.el (eudc-ldap-cleanup-record-simple): Mark as
+	obsolete.
+	(eudc-ldap-cleanup-record-filtering-addresses): Add docstring.
+	Don't clean up postal addresses if ldap-ignore-attribute-codings
+	is set.  Combine mail addresses into one field. (Bug#17720)
+	(eudc-ldap-simple-query-internal): Call
+	eudc-ldap-cleanup-record-filtering-addresses instead of
+	eudc-ldap-cleanup-record-simple.
+	(eudc-ldap-get-field-list): Likewise.
+
 2015-03-05  Ivan Shmakov  <ivan@siamics.net>
 
 	* net/eww.el (eww-html-p): New function (bug#20009).
diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el
index 1d426a7b7b0..d22dff615ee 100644
--- a/lisp/net/eudcb-ldap.el
+++ b/lisp/net/eudcb-ldap.el
@@ -74,13 +74,10 @@
 
 (defun eudc-ldap-cleanup-record-simple (record)
   "Do some cleanup in a RECORD to make it suitable for EUDC."
+  (declare (obsolete eudc-ldap-cleanup-record-filtering-addresses "25.1"))
   (mapcar
    (function
     (lambda (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)
@@ -90,22 +87,36 @@
 (defun eudc-filter-$ (string)
   (mapconcat 'identity (split-string string "\\$") "\n"))
 
-;; Cleanup a LDAP record to make it suitable for EUDC:
-;;   Make the record a cons-cell instead of a list if it is single-valued
-;;   Filter the $ character in addresses into \n if not done by the LDAP lib
 (defun eudc-ldap-cleanup-record-filtering-addresses (record)
-  (mapcar
-   (function
-    (lambda (field)
+  "Clean up RECORD to make it suitable for EUDC.
+Make the record a cons-cell instead of a list if it is
+single-valued.  Change the `$' character in postal addresses to a
+newline.  Combine separate mail fields into one mail field with
+multiple addresses."
+  (let ((clean-up-addresses (or (not (boundp 'ldap-ignore-attribute-codings))
+				(not ldap-ignore-attribute-codings)))
+	result mail-addresses)
+    (dolist (field record)
+      ;; 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.
       (let ((name (intern (downcase (car field))))
 	    (value (cdr field)))
-	(if (memq name '(postaladdress registeredaddress))
-	    (setq value (mapcar 'eudc-filter-$ value)))
-	(cons name
-	      (if (cdr value)
-		  value
-		(car value))))))
-   record))
+	(when (and clean-up-addresses
+		   (memq name '(postaladdress registeredaddress)))
+	  (setq value (mapcar 'eudc-filter-$ value)))
+	(if (eq name 'mail)
+	    (setq mail-addresses (append mail-addresses value))
+	  (push (cons name (if (cdr value)
+			       value
+			     (car value)))
+		result))))
+    (push (cons 'mail (if (cdr mail-addresses)
+			  mail-addresses
+			(car mail-addresses)))
+          result)
+    (nreverse result)))
 
 (defun eudc-ldap-simple-query-internal (query &optional return-attrs)
   "Query the LDAP server with QUERY.
@@ -118,11 +129,7 @@ RETURN-ATTRS is a list of attributes to return, defaulting to
 			     (if (listp return-attrs)
 				 (mapcar 'symbol-name return-attrs))))
 	final-result)
-    (if (or (not (boundp 'ldap-ignore-attribute-codings))
-	    ldap-ignore-attribute-codings)
-	(setq result
-	      (mapcar 'eudc-ldap-cleanup-record-filtering-addresses result))
-      (setq result (mapcar 'eudc-ldap-cleanup-record-simple result)))
+    (setq result (mapcar 'eudc-ldap-cleanup-record-filtering-addresses result))
 
     (if (and eudc-strict-return-matches
 	     return-attrs
@@ -148,7 +155,7 @@ attribute names are returned. Default to `person'"
   (let ((ldap-host-parameters-alist
 	 (list (cons eudc-server
 		     '(scope subtree sizelimit 1)))))
-    (mapcar 'eudc-ldap-cleanup-record-simple
+    (mapcar 'eudc-ldap-cleanup-record-filtering-addresses
 	    (ldap-search
 	     (eudc-ldap-format-query-as-rfc1558
 	      (list (cons "objectclass"