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

* Re: Fix eudc-get-attribute-list: please review
  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
  0 siblings, 1 reply; 3+ messages in thread
From: Thomas Fitzsimmons @ 2022-04-14  2:02 UTC (permalink / raw)
  To: emacs-devel

Hi Filipp,

Filipp Gunbin <fgunbin@fastmail.fm> writes:

> 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.

Looks good, and works for me.  Please go ahead and push this to the
master branch.  One question: what does the addition of the question
mark to the regexp fix?

Thanks,
Thomas



^ permalink raw reply	[flat|nested] 3+ messages in thread

* Re: Fix eudc-get-attribute-list: please review
  2022-04-14  2:02 ` Thomas Fitzsimmons
@ 2022-04-14 13:57   ` Filipp Gunbin
  0 siblings, 0 replies; 3+ messages in thread
From: Filipp Gunbin @ 2022-04-14 13:57 UTC (permalink / raw)
  To: Thomas Fitzsimmons; +Cc: emacs-devel

Hi Thomas,

On 13/04/2022 22:02 -0400, Thomas Fitzsimmons wrote:

> Hi Filipp,
>
> Filipp Gunbin <fgunbin@fastmail.fm> writes:
>
>> 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.
>
> Looks good, and works for me.  Please go ahead and push this to the
> master branch.

Thank you for the reply, now pushed.

> One question: what does the addition of the question
> mark to the regexp fix?

This is what ldapsearch returns with -A:

--8<---------------cut here---------------start------------->8---
Enter LDAP Password:
version: 1

dn:: ....
objectClass:
cn:
sn:
--8<---------------cut here---------------end--------------->8---

So we should accept empty values.


I've also pushed this additional cleanup commit:

commit 3bd20fc696cdfb072b56c38a0669f95c5febfa2f
Author: Filipp Gunbin <fgunbin@fastmail.fm>
Date:   Thu Apr 14 16:47:32 2022 +0300

    ldap-search-internal cleanup
    
    * lisp/net/ldap.el (ldap-ldapsearch-args): Change -LL to -LLL to
    suppress ldif version output.
    (ldap-search-internal): Remove skipping of version output.  Remove
    redundand ws skipping.

diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
index 9463282135..da45457891 100644
--- a/lisp/net/ldap.el
+++ b/lisp/net/ldap.el
@@ -148,7 +148,7 @@ ldap-ldapsearch-prog
   "The name of the ldapsearch command line program."
   :type '(string :tag "`ldapsearch' Program"))
 
-(defcustom ldap-ldapsearch-args '("-LL" "-tt")
+(defcustom ldap-ldapsearch-args '("-LLL" "-tt")
   "A list of additional arguments to pass to `ldapsearch'."
   :type '(repeat :tag "`ldapsearch' Arguments"
 		 (string :tag "Argument")))
@@ -682,7 +682,7 @@ ldap-search-internal
       (while (re-search-forward (concat "[\t\n\f]+ \\|"
 					ldap-ldapsearch-password-prompt-regexp)
 				nil t)
-	(replace-match "" nil nil))
+	(replace-match ""))
       (goto-char (point-min))
 
       (if (looking-at "usage")
@@ -691,7 +691,6 @@ ldap-search-internal
 	;; Skip error message when retrieving attribute list
 	(if (looking-at "Size limit exceeded")
 	    (forward-line 1))
-        (if (looking-at "version:") (forward-line 1)) ;bug#12724.
 	(while (progn
 		 (skip-chars-forward " \t\n")
 		 (not (eobp)))
@@ -724,7 +723,6 @@ ldap-search-internal
 		(record
 		 (push (nreverse record) result)))
 	  (setq record nil)
-	  (skip-chars-forward " \t\n")
 	  (message "Parsing results... %d" numres)
 	  (setq numres (1+ numres)))
 	(message "Parsing results... done")


Here, it's cleaner to use -LLL to omit ldif version than to skip it.
This option is available since OpenLDAP 2.0 (released in 2000), and
ldap-ldapsearch-args is anyway a defcustom.

skip-chars-forward at the end of while body is not needed because we do
that in the while's test.

Thanks.
Filipp



^ 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).