[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 2a2f5530fa 1/2: Fix eudc-get-attribute-list
From: |
Filipp Gunbin |
Subject: |
master 2a2f5530fa 1/2: Fix eudc-get-attribute-list |
Date: |
Thu, 14 Apr 2022 09:53:07 -0400 (EDT) |
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