mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-16 17:24:23 +00:00
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:
parent
36da6ceb92
commit
2a2f5530fa
4 changed files with 39 additions and 19 deletions
|
|
@ -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}
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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) "")
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue