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.
This commit is contained in:
Filipp Gunbin 2022-04-13 23:10:35 +03:00
parent 36da6ceb92
commit 2a2f5530fa
4 changed files with 39 additions and 19 deletions

View file

@ -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}

View file

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

View file

@ -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) "")

View file

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