From 2a2f5530fa230e2b994be5683e63763833bb6a0a Mon Sep 17 00:00:00 2001
From: Filipp Gunbin <fgunbin@fastmail.fm>
Date: Wed, 13 Apr 2022 23:10:35 +0300
Subject: [PATCH] Fix eudc-get-attribute-list

* lisp/net/eudc-vars.el (eudc-ldap-no-wildcard-attributes): New
defcustom.
* doc/misc/eudc.texi (LDAP Configuration): Mention it.
* lisp/net/eudcb-ldap.el (eudc-ldap-format-query-as-rfc1558): Use it.
(eudc-ldap-get-field-list): Set scope and sizelimit, instead of
overriding the whole ldap-host-parameters-alist.
* lisp/net/ldap.el (ldap-search-internal): Allow "size limit exceeded"
exit code.  Allow empty attribute values.
---
 doc/misc/eudc.texi     |  4 +++-
 lisp/net/eudc-vars.el  |  9 +++++++++
 lisp/net/eudcb-ldap.el | 41 +++++++++++++++++++++++++----------------
 lisp/net/ldap.el       |  4 ++--
 4 files changed, 39 insertions(+), 19 deletions(-)

diff --git a/doc/misc/eudc.texi b/doc/misc/eudc.texi
index 71e3e6b9ed7..d2850282fea 100644
--- a/doc/misc/eudc.texi
+++ b/doc/misc/eudc.texi
@@ -254,7 +254,9 @@ To: * Smith
 @noindent
 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.
+the wildcard character to the end of the last word, except if the word
+corresponds to an attribute which is a member of
+`eudc-ldap-no-wildcard-attributes'.
 
 @menu
 * Emacs-only Configuration::    Configure with @file{.emacs}
diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el
index d58fab896ed..90d89e87fba 100644
--- a/lisp/net/eudc-vars.el
+++ b/lisp/net/eudc-vars.el
@@ -425,6 +425,15 @@ BBDB fields.  SPECs are sexps which are evaluated:
 		       (symbol :tag "BBDB Field")
 		       (sexp :tag "Conversion Spec"))))
 
+(defcustom eudc-ldap-no-wildcard-attributes
+  '(objectclass objectcategory)
+  "LDAP attributes which are always searched for without wildcard character.
+This is the list of special dictionary-valued attributes, where
+wildcarded search may fail.  For example, it fails with
+objectclass in Active Directory servers."
+  :type  '(repeat (symbol :tag "Directory attribute")))
+
+
 ;;}}}
 
 ;;{{{ BBDB Custom Group
diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el
index 365dace961a..1201c84f2d3 100644
--- a/lisp/net/eudcb-ldap.el
+++ b/lisp/net/eudcb-ldap.el
@@ -151,16 +151,20 @@ attribute names are returned.  Default to `person'."
   (interactive)
   (or eudc-server
       (call-interactively 'eudc-set-server))
-  (let ((ldap-host-parameters-alist
-	 (list (cons eudc-server
-		     '(scope subtree sizelimit 1)))))
-    (mapcar #'eudc-ldap-cleanup-record-filtering-addresses
-	    (ldap-search
-	     (eudc-ldap-format-query-as-rfc1558
-	      (list (cons "objectclass"
-			  (or objectclass
-			      "person"))))
-	     eudc-server nil t))))
+  (let ((plist (copy-sequence
+                (alist-get eudc-server ldap-host-parameters-alist
+                           nil nil #'equal))))
+    (plist-put plist 'scope 'subtree)
+    (plist-put plist 'sizelimit '1)
+    (let ((ldap-host-parameters-alist
+           (list (cons eudc-server plist))))
+      (mapcar #'eudc-ldap-cleanup-record-filtering-addresses
+	      (ldap-search
+	       (eudc-ldap-format-query-as-rfc1558
+	        (list (cons 'objectclass
+			    (or objectclass
+			        "person"))))
+	       eudc-server nil t)))))
 
 (defun eudc-ldap-escape-query-special-chars (string)
   "Value is STRING with characters forbidden in LDAP queries escaped."
@@ -178,12 +182,17 @@ 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."
-  (let ((formatter (lambda (item &optional wildcard)
-		     (format "(%s=%s)"
-			     (car item)
-			     (concat
-			      (eudc-ldap-escape-query-special-chars
-			       (cdr item)) (if wildcard "*" ""))))))
+  (let ((formatter
+         (lambda (item &optional wildcard)
+	   (format "(%s=%s)"
+		   (car item)
+		   (concat
+		    (eudc-ldap-escape-query-special-chars
+		     (cdr item))
+                    (if (and wildcard
+                             (not (memq (car item)
+                                        eudc-ldap-no-wildcard-attributes)))
+                        "*" ""))))))
     (format "(&%s)"
 	    (concat
 	     (mapconcat formatter (butlast query) "")
diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
index ce6c270e0bc..94632821353 100644
--- a/lisp/net/ldap.el
+++ b/lisp/net/ldap.el
@@ -663,7 +663,7 @@ an alist of attribute/value pairs."
 	    (while (not (memq (process-status proc) '(exit signal)))
 	      (sit-for 0.1))
 	    (let ((status (process-exit-status proc)))
-	      (when (not (eq status 0))
+	      (when (not (memql status '(0 4))) ; 4 = Size limit exceeded
 		;; Handle invalid credentials exit status specially
 		;; for ldap-password-read.
 		(if (eq status 49)
@@ -699,7 +699,7 @@ an alist of attribute/value pairs."
 	  (forward-line 1)
           (while (looking-at "^\\([A-Za-z][-A-Za-z0-9]*\
 \\|[0-9]+\\(?:\\.[0-9]+\\)*\\)\\(;[-A-Za-z0-9]+\\)*[=:\t ]+\
-\\(<[\t ]*file://\\)\\(.*\\)$")
+\\(<[\t ]*file://\\)?\\(.*\\)$")
 	    (setq name (match-string 1)
 		  value (match-string 4))
             ;; Need to handle file:///D:/... as generated by OpenLDAP
-- 
2.39.5