From: Michael Albinus <michael.albinus@gmx.de>
Date: Sat, 22 Mar 2025 08:52:22 +0000 (+0100)
Subject: Tramp: Improve handling of cyclic symlinks
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=5a37039ff048bd464405c5c8be4d1fb7d7cd1b48;p=emacs.git

Tramp: Improve handling of cyclic symlinks

* lisp/net/tramp-sh.el (tramp-sh-handle-file-ownership-preserved-p):
Add FIXME.

* lisp/net/tramp.el (tramp-skeleton-file-exists-p)
(tramp-handle-file-directory-p): Protect against cyclic symlinks.

* test/lisp/net/tramp-tests.el (tramp-test18-file-attributes)
(tramp-test21-file-links): Adapt tests.

(cherry picked from commit 172e35afce430594fdf2eb9c404efc398098d621)
---

diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 6d13652504a..916a2e698d5 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1859,7 +1859,10 @@ ID-FORMAT valid values are `string' and `integer'."
                  ;; test.
                  (tramp-check-remote-uname v tramp-bsd-unames)
 		 (= (file-attribute-group-id attributes)
-		    (tramp-get-remote-gid v 'integer)))))))))
+		    (tramp-get-remote-gid v 'integer))
+		 ;; FIXME: `file-ownership-preserved-p' tests also the
+		 ;; ownership of the parent directory.  We don't.
+		 )))))))
 
 ;; Directory listings.
 
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 4552ec52a9c..db40cbbb820 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3579,8 +3579,10 @@ BODY is the backend specific code."
 		    (fa (tramp-get-file-property v localname "file-attributes"))
 		    ((not (stringp (car fa)))))))
 	      ;; Symlink to a non-existing target counts as nil.
+	      ;; Protect against cyclic symbolic links.
 	      ((file-symlink-p ,filename)
-	       (file-exists-p (file-truename ,filename)))
+	       (ignore-errors
+		 (file-exists-p (file-truename ,filename))))
 	      (t ,@body)))))))
 
 (defmacro tramp-skeleton-file-local-copy (filename &rest body)
@@ -4189,10 +4191,9 @@ Let-bind it when necessary.")
 (defun tramp-handle-file-directory-p (filename)
   "Like `file-directory-p' for Tramp files."
   ;; `file-truename' could raise an error, for example due to a cyclic
-  ;; symlink.  We don't protect this despite it, because other errors
-  ;; might be worth to be visible, for example impossibility to mount
-  ;; in tramp-gvfs.el.
-  (eq (file-attribute-type (file-attributes (file-truename filename))) t))
+  ;; symlink.
+  (ignore-errors
+    (eq (file-attribute-type (file-attributes (file-truename filename))) t)))
 
 (defun tramp-handle-file-equal-p (filename1 filename2)
   "Like `file-equalp-p' for Tramp files."
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index ecbb8744b9a..54f66c26537 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -3848,6 +3848,7 @@ This tests also `access-file', `file-readable-p',
 	    (should (stringp (file-attribute-user-id attr)))
 	    (should (stringp (file-attribute-group-id attr)))
 
+	    ;; Symbolic links.
 	    (tramp--test-ignore-make-symbolic-link-error
 	      (should-error
 	       (access-file tmp-name2 "error")
@@ -3869,17 +3870,24 @@ This tests also `access-file', `file-readable-p',
 		(file-remote-p (file-truename tmp-name1) 'localname)))
 	      (delete-file tmp-name2)
 
-	      ;; A non-existent link target makes the file unaccessible.
-	      (make-symbolic-link "error" tmp-name2)
-	      (should (file-symlink-p tmp-name2))
-	      (should-error
-	       (access-file tmp-name2 "error")
-	       :type 'file-missing)
-	      ;; `file-ownership-preserved-p' should return t for
-	      ;; symlinked files to a non-existing target.
-	      (when test-file-ownership-preserved-p
-		(should (file-ownership-preserved-p tmp-name2 'group)))
-	      (delete-file tmp-name2))
+	      ;; A non-existent or cyclic link target makes the file
+	      ;; unaccessible.
+	      (dolist (target
+		       `("does-not-exist" ,(file-name-nondirectory tmp-name2)))
+		(make-symbolic-link target tmp-name2)
+		(should (file-symlink-p tmp-name2))
+		(should-not (file-exists-p tmp-name2))
+		(should-not (file-directory-p tmp-name2))
+		(should-error
+		 (access-file tmp-name2 "error")
+		 :type
+		 (if (string-equal target "does-not-exist")
+		     'file-missing 'file-error))
+		;; `file-ownership-preserved-p' should return t for
+		;; symlinked files to a non-existing or cyclic target.
+		(when test-file-ownership-preserved-p
+		  (should (file-ownership-preserved-p tmp-name2 'group)))
+		(delete-file tmp-name2)))
 
 	    ;; Check, that "//" in symlinks are handled properly.
 	    (with-temp-buffer
@@ -4528,12 +4536,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
 	       (make-symbolic-link tmp-name1 tmp-name2)
 	       (should (file-symlink-p tmp-name1))
 	       (should (file-symlink-p tmp-name2))
-	       (should-error
-		(file-regular-p tmp-name1)
-		:type 'file-error)
-	       (should-error
-		(file-regular-p tmp-name2)
-		:type 'file-error))))
+	       (should-not (file-regular-p tmp-name1))
+	       (should-not (file-regular-p tmp-name2)))))
 
 	;; Cleanup.
 	(ignore-errors