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

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

diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
index 78405414a28e786ca52a56f7d5668146da1e3903..5c3766a76b31d214688c6c7671f2fc110c107535 100644 (file)
--- a/lisp/net/ldap.el
+++ b/lisp/net/ldap.el
@@ -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")