From ada8822c45baa61fcfc06d11643969dd24bf5393 Mon Sep 17 00:00:00 2001
From: Filipp Gunbin <fgunbin@fastmail.fm>
Date: Tue, 20 Jun 2023 20:43:32 +0300
Subject: [PATCH] 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.
---
 lisp/net/ldap.el | 69 +++++++++++++++++++++++++++++-------------------
 1 file changed, 42 insertions(+), 27 deletions(-)

diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
index 78405414a28..5c3766a76b3 100644
--- 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")
-- 
2.39.2