From f5834c9ba06529bcd0a6da464f0a808e1be53c5c Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 26 Mar 2018 14:33:24 +0200 Subject: [PATCH] Fix problem with trailing slash in Tramp * lisp/net/tramp.el (tramp-handle-file-truename): * lisp/net/tramp-adb.el (tramp-adb-handle-file-truename): * lisp/net/tramp-sh.el (tramp-sh-handle-file-truename): Fix problem with trailing slash. * test/lisp/net/tramp-tests.el (tramp-test21-file-links): Test also quoted directories. --- lisp/net/tramp-adb.el | 25 ++++++++++++++++++------- lisp/net/tramp-sh.el | 11 +++++------ lisp/net/tramp.el | 28 +++++++++++++--------------- test/lisp/net/tramp-tests.el | 16 +++++++++------- 4 files changed, 45 insertions(+), 35 deletions(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 7a0ea71aee9..fbf6196ca46 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -278,13 +278,16 @@ pass to the OPERATION." ;; code could be shared? (defun tramp-adb-handle-file-truename (filename) "Like `file-truename' for Tramp files." - (format - "%s%s" + ;; Preserve trailing "/". + (funcall + (if (string-equal (file-name-nondirectory filename) "") + 'file-name-as-directory 'identity) (with-parsed-tramp-file-name (expand-file-name filename) nil (tramp-make-tramp-file-name v (with-tramp-file-property v localname "file-truename" - (let ((result nil)) ; result steps in reverse order + (let ((result nil) ; result steps in reverse order + (quoted (tramp-compat-file-name-quoted-p localname))) (tramp-message v 4 "Finding true name for `%s'" filename) (let* ((steps (split-string localname "/" 'omit)) (localnamedir (tramp-run-real-handler @@ -354,11 +357,19 @@ pass to the OPERATION." (not (string= (substring result -1) "/")))) (setq result (concat result "/")))) + ;; Detect cycle. + (when (and (file-symlink-p filename) + (string-equal result localname)) + (tramp-error + v 'file-error + "Apparent cycle of symbolic links for %s" filename)) + ;; If the resulting localname looks remote, we must quote it + ;; for security reasons. + (when (or quoted (file-remote-p result)) + (let (file-name-handler-alist) + (setq result (tramp-compat-file-name-quote result)))) (tramp-message v 4 "True name of `%s' is `%s'" localname result) - result)))) - - ;; Preserve trailing "/". - (if (string-equal (file-name-nondirectory filename) "") "/" ""))) + result)))))) (defun tramp-adb-handle-file-attributes (filename &optional id-format) "Like `file-attributes' for Tramp files." diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 4d7359a4c9c..4cdc39e0b6a 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1128,8 +1128,10 @@ component is used as the target of the symlink." (defun tramp-sh-handle-file-truename (filename) "Like `file-truename' for Tramp files." - (format - "%s%s" + ;; Preserve trailing "/". + (funcall + (if (string-equal (file-name-nondirectory filename) "") + 'file-name-as-directory 'identity) (with-parsed-tramp-file-name (expand-file-name filename) nil (tramp-make-tramp-file-name method user domain host port @@ -1233,10 +1235,7 @@ component is used as the target of the symlink." (let (file-name-handler-alist) (setq result (tramp-compat-file-name-quote result)))) (tramp-message v 4 "True name of `%s' is `%s'" localname result) - result)))) - - ;; Preserve trailing "/". - (if (string-equal (file-name-nondirectory filename) "") "/" ""))) + result)))))) ;; Basic functions. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 255c58e48f5..4497802d770 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3208,17 +3208,18 @@ User is always nil." (defun tramp-handle-file-truename (filename) "Like `file-truename' for Tramp files." - (let ((result (expand-file-name filename)) - (numchase 0) - ;; Don't make the following value larger than - ;; necessary. People expect an error message in a - ;; timely fashion when something is wrong; - ;; otherwise they might think that Emacs is hung. - ;; Of course, correctness has to come first. - (numchase-limit 20) - symlink-target) - (format - "%s%s" + ;; Preserve trailing "/". + (funcall + (if (string-equal (file-name-nondirectory filename) "") + 'file-name-as-directory 'identity) + (let ((result (expand-file-name filename)) + (numchase 0) + ;; Don't make the following value larger than necessary. + ;; People expect an error message in a timely fashion when + ;; something is wrong; otherwise they might think that Emacs + ;; is hung. Of course, correctness has to come first. + (numchase-limit 20) + symlink-target) (with-parsed-tramp-file-name result v1 (with-tramp-file-property v1 v1-localname "file-truename" (while (and (setq symlink-target (file-symlink-p result)) @@ -3243,10 +3244,7 @@ User is always nil." (tramp-error v1 'file-error "Maximum number (%d) of symlinks exceeded" numchase-limit))) - (directory-file-name result))) - - ;; Preserve trailing "/". - (if (string-equal (file-name-nondirectory filename) "") "/" "")))) + (directory-file-name result)))))) (defun tramp-handle-find-backup-file-name (filename) "Like `find-backup-file-name' for Tramp files." diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 8e21f5220fc..5851840d009 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3117,13 +3117,15 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (delete-file tmp-name1) (delete-file tmp-name2))) - ;; `file-truename' shall preserve trailing link of directories. - (unless (file-symlink-p tramp-test-temporary-file-directory) - (let* ((dir1 (directory-file-name tramp-test-temporary-file-directory)) - (dir2 (file-name-as-directory dir1))) - (should (string-equal (file-truename dir1) (expand-file-name dir1))) - (should - (string-equal (file-truename dir2) (expand-file-name dir2)))))))) + ;; `file-truename' shall preserve trailing slash of directories. + (let* ((dir1 + (directory-file-name + (funcall + (if quoted 'tramp-compat-file-name-quote 'identity) + tramp-test-temporary-file-directory))) + (dir2 (file-name-as-directory dir1))) + (should (string-equal (file-truename dir1) (expand-file-name dir1))) + (should (string-equal (file-truename dir2) (expand-file-name dir2))))))) (ert-deftest tramp-test22-file-times () "Check `set-file-times' and `file-newer-than-file-p'." -- 2.39.5