unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* Fix eudc-get-attribute-list: please review
@ 2022-04-13 20:14 Filipp Gunbin
  2022-04-14  2:02 ` Thomas Fitzsimmons
  0 siblings, 1 reply; 3+ messages in thread
From: Filipp Gunbin @ 2022-04-13 20:14 UTC (permalink / raw)
  To: fitzsim; +Cc: emacs-devel

Hi,

Here's the patch which fixes several bugs preventing
eudc-get-attribute-list from working, please review.

TIA,
Filipp


commit 17c59e12adca5386ffe7d107dc6e3fa2dcf8b8d6
Author: Filipp Gunbin <fgunbin@fastmail.fm>
Date:   Wed Apr 13 23:10:35 2022 +0300

    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.

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 @@ LDAP Configuration
 @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 @@ eudc-ldap-bbdb-conversion-alist
 		       (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 @@ eudc-ldap-get-field-list
   (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 @@ eudc-ldap-escape-query-special-chars
 
 (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 @@ ldap-search-internal
 	    (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 @@ ldap-search-internal
 	  (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



^ permalink raw reply related	[flat|nested] 3+ messages in thread
end of thread, other threads:[~2022-04-14 13:57 UTC | newest]

Thread overview: 3+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2022-04-13 20:14 Fix eudc-get-attribute-list: please review Filipp Gunbin
2022-04-14  2:02 ` Thomas Fitzsimmons
2022-04-14 13:57   ` Filipp Gunbin

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).