procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix ldap-search when WITHDN is non-nil (bug#64089)

Browse source 
* lisp/net/ldap.el (ldap-search): Apply ldap-decode-attribute only to
attribute pairs.
(ldap-search-internal): Parse dn with the same regexp as other attrs;
use its value instead of the whole line.  Include entry into result
only if valid dn is present, to avoid treating process sentinel
messages like an entry.  Fix accidental match data clobbering.
Document return value format.
This commit is contained in:
Filipp Gunbin 2023-06-20 20:43:32 +03:00
parent 8806bbbf2c
commit ada8822c45
1 changed files with 42 additions and 27 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

69
lisp/net/ldap.el
View file

@ -472,7 +472,8 @@ the associated values.
If WITHDN is non-nil, each entry in the result will be prepended with
its distinguished name WITHDN.
Additional search parameters can be specified through
`ldap-host-parameters-alist', which see."
`ldap-host-parameters-alist', which see.
See `ldap-search-internal' for the description of return value."
(interactive "sFilter:")
(or host
(setq host ldap-default-host)
@ -487,7 +488,9 @@ Additional search parameters can be specified through
(if ldap-ignore-attribute-codings
result
(mapcar (lambda (record)
(mapcar #'ldap-decode-attribute record))
(append (and withdn (list (car record)))
(mapcar #'ldap-decode-attribute
(if withdn (cdr record) record))))
result))))
(defun ldap-password-read (host)
@ -570,8 +573,13 @@ RFC 1779 syntax).
`sizelimit' is the maximum number of matches to return.
`withdn' if non-nil each entry in the result will be prepended with
its distinguished name DN.
The function returns a list of matching entries. Each entry is itself
an alist of attribute/value pairs."
The function returns a list of matching entries. Each entry is
itself a list ATTRS of (ATTR VALUE) pairs; `dn' attribute is not
included.
When `withdn' is non-nil the result is instead an alist with
elements (DN . ATTRS), where DN is a string value and ATTRS is
same as above."
(let* ((buf (get-buffer-create " *ldap-search*"))
(bufval (get-buffer-create " *ldap-value*"))
(host (or (plist-get search-plist 'host)
@ -703,35 +711,42 @@ an alist of attribute/value pairs."
(while (progn
(skip-chars-forward " \t\n")
(not (eobp)))
(setq dn (buffer-substring (point) (line-end-position)))
(forward-line 1)
(while (looking-at "^\\([A-Za-z][-A-Za-z0-9]*\
\\|[0-9]+\\(?:\\.[0-9]+\\)*\\)\\(;[-A-Za-z0-9]+\\)*[=:\t ]+\
\\(<[\t ]*file://\\)?\\(.*\\)$")
(setq name (match-string 1)
value (match-string 4))
;; Need to handle file:///D:/... as generated by OpenLDAP
;; on DOS/Windows as local files.
(if (and (memq system-type '(windows-nt ms-dos))
(eq (string-match "/\\(.:.*\\)$" value) 0))
(setq value (match-string 1 value)))
;; Do not try to open non-existent files
(if (match-string 3)
(with-current-buffer bufval
(erase-buffer)
(set-buffer-multibyte nil)
(insert-file-contents-literally value)
(delete-file value)
(setq value (buffer-string)))
(setq value " "))
(setq record (cons (list name value)
record))
(when (memq system-type '(windows-nt ms-dos))
;; Need to handle file:///D:/... as generated by
;; OpenLDAP on DOS/Windows as local files.
(save-match-data
(when (eq (string-match "/\\(.:.*\\)$" value) 0)
(setq value (match-string 1 value)))))
(cond ((match-string 3) ;normal value written to a file
(with-current-buffer bufval
(erase-buffer)
(set-buffer-multibyte nil)
(insert-file-contents-literally value)
(delete-file value)
(setq value (buffer-string))))
(;; dn is output inline
(string-equal-ignore-case name "dn")
(setq dn value
name nil
value nil))
(t (setq value " ")))
(and name value
(setq record (cons (list name value)
record)))
(forward-line 1))
(cond (withdn
(push (cons dn (nreverse record)) result))
(record
(push (nreverse record) result)))
(setq record nil)
(when dn
(cond (withdn
(push (cons dn (nreverse record))
result))
(record
(push (nreverse record) result))))
(setq record nil
dn nil)
(message "Parsing results... %d" numres)
(setq numres (1+ numres)))
(message "Parsing results... done")