bug#64089: 30.0.50; `ldap-search' errors out with `wrong-type-argument listp' when called WITHDN == t

[Filipp Gunbin <fgunbin@fastmail.fm>]

Hi Jens, thanks for reporting this.

On 16/06/2023 00:11 +0200, Jens Schmidt wrote:

> With the following patch things work as expected:
>
> (ldap-search "(uid=<uid>)"
>               "ldap://<host>"
>               '("mail")
>               nil
>               t)
> => ((("dn" "cn=<NAME>,L=<REGION>,DC=<DOMAIN>,DC=COM") ("mail"
> "<name>@<domain>.com")))
>
> I tried to make the patch as conservative as possible and
> intentionally do not check syntax of the dn line if its parsing is not
> required.

I think I have better patch here.  This is what it addresses:

1) The bug you reported.  My patch tries to keep the API intact (we
don't want breakage, however I think not much people actually use withdn
arg): return dn as a string, prepended to attribute alist.

2) dn is now parsed just like the other attributes, with the same
regexp.

3) (unrelated, just noticed and fixed) Match data clobbering in this
piece:

-            ;; 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)))

4) This code:

+          (when dn
+	    (cond (withdn 
+		   (push (cons dn (nreverse record))
+                         result))

intentionally doesn't check whether record is non-nil:  potentially we
could request "no attributes" (there's an option for that in ldapsearch,
however I don't think this is currently possible in ldap.el), and it's
ok to return just dn.

Please give it a try, if it's OK and others have no objections, I'll
install it on Monday (on master, I guess).

Thanks.
Filipp

diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
index 78405414a28..3048b7e7a2f 100644
--- a/lisp/net/ldap.el
+++ b/lisp/net/ldap.el
@@ -487,7 +487,9 @@ ldap-search
     (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)
@@ -703,35 +705,42 @@ ldap-search-internal
 	(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")