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 6d13652504a5dcc483bcb6c5287d37472631d6b0..916a2e698d5592fbf9c8a362d865b5078c55260b 100644 (file)
--- 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 4552ec52a9cc8bac5dd621f0c984f424b3896478..db40cbbb820a202ab10d8131ffa77b362bdd04c9 100644 (file)
--- 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 ecbb8744b9aa6928c6c2fbabf027538a3cef13b0..54f66c265373ffc16d187e3e373457a23d6e8372 100644 (file)
--- 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