procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Tramp: Improve handling of cyclic symlinks

Browse source 
* 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.
This commit is contained in:
Michael Albinus 2025-03-22 09:52:22 +01:00
parent 049d7202f3
commit 172e35afce
3 changed files with 31 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
lisp/net/tramp-sh.el
View file

@ -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.

11
lisp/net/tramp.el
View file

@ -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."

38
test/lisp/net/tramp-tests.el
View file

@ -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