master 2a2f5530fa 1/2: Fix eudc-get-attribute-list

[Filipp Gunbin]

branch: master
commit 2a2f5530fa230e2b994be5683e63763833bb6a0a
Author: Filipp Gunbin <fgunbin@fastmail.fm>
Commit: Filipp Gunbin <fgunbin@fastmail.fm>

    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 71e3e6b9ed..d2850282fe 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 d58fab896e..90d89e87fb 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 365dace961..1201c84f2d 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 ce6c270e0b..9463282135 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