master 172e35afce4: Tramp: Improve handling of cyclic symlinks

[Michael Albinus]

branch: master
commit 172e35afce430594fdf2eb9c404efc398098d621
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    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.
---
 lisp/net/tramp-sh.el         |  5 ++++-
 lisp/net/tramp.el            | 11 ++++++-----
 test/lisp/net/tramp-tests.el | 38 +++++++++++++++++++++-----------------
 3 files changed, 31 insertions(+), 23 deletions(-)

diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 2b113ba1acf..5e79d4be41e 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1857,7 +1857,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 366847e4e00..d8b58bf13e9 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3584,8 +3584,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)
@@ -4194,10 +4196,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 0d853f1eab6..55461819f66 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