From: Michael Albinus Date: Wed, 30 Aug 2017 10:00:26 +0000 (+0200) Subject: Improve symlinks for Tramp X-Git-Tag: emacs-26.0.90~301 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=9376ea3f6c736f62cc064088b2e020a9f89bae63;p=emacs.git Improve symlinks for Tramp * lisp/files.el (files--splice-dirname-file): Quote whole file. * lisp/net/tramp-sh.el (tramp-sh-handle-make-symbolic-link): Do not expand TARGET, it could be remote. (tramp-sh-handle-file-truename): Check for cyclic symlink also in case of readlink. Quote result if it looks remote. (tramp-sh-handle-file-local-copy): Use `file-truename'. * test/lisp/net/tramp-tests.el (tramp-test08-file-local-copy) (tramp-test09-insert-file-contents): Test also file missing. (tramp-test21-file-links): Extend test. --- diff --git a/lisp/files.el b/lisp/files.el index 7754be29643..8cec3d45dce 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1165,7 +1165,8 @@ directory name and leading `~' and `/:' are not special in FILE." (if (eq (find-file-name-handler dirname 'file-symlink-p) (find-file-name-handler file 'file-symlink-p)) file - (file-name-quote file)) + ;; If `file' is remote, we want to quote it at the beginning. + (let (file-name-handler-alist) (file-name-quote file))) (concat dirname file))) (defun file-truename (filename &optional counter prev-dirs) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 6494b0957bf..85966f122d2 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1086,7 +1086,7 @@ component is used as the target of the symlink." ;; If TARGET is a Tramp name, use just the localname component. (when (and (tramp-tramp-file-p target) (tramp-file-name-equal-p - v (tramp-dissect-file-name (expand-file-name target)))) + v (tramp-dissect-file-name target))) (setq target (tramp-file-name-localname (tramp-dissect-file-name (expand-file-name target))))) @@ -1132,7 +1132,12 @@ component is used as the target of the symlink." (tramp-shell-quote-argument localname))) (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) - (setq result (buffer-substring (point-min) (point-at-eol))))) + (setq result (buffer-substring (point-min) (point-at-eol)))) + (when (and (file-symlink-p filename) + (string-equal result localname)) + (tramp-error + v 'file-error + "Apparent cycle of symbolic links for %s" filename))) ;; Use Perl implementation. ((and (tramp-get-remote-perl v) @@ -1214,8 +1219,11 @@ component is used as the target of the symlink." "/")) (when (string= "" result) (setq result "/"))))) - - (when quoted (setq result (tramp-compat-file-name-quote result))) + ;; 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)))) @@ -3072,7 +3080,7 @@ the result will be a local, non-Tramp, file name." (defun tramp-sh-handle-file-local-copy (filename) "Like `file-local-copy' for Tramp files." (with-parsed-tramp-file-name filename nil - (unless (file-exists-p filename) + (unless (file-exists-p (file-truename filename)) (tramp-error v tramp-file-missing "Cannot make local copy of non-existing file `%s'" filename)) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 201ac10dcc2..662163f3fec 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -1762,7 +1762,13 @@ This checks also `file-name-as-directory', `file-name-directory', (tramp-copy-size-limit 4) (tramp-inline-compress-start-size 2)) (delete-file tmp-name2) - (should (setq tmp-name2 (file-local-copy tmp-name1))))) + (should (setq tmp-name2 (file-local-copy tmp-name1)))) + ;; Error case. + (delete-file tmp-name1) + (delete-file tmp-name2) + (should-error + (setq tmp-name2 (file-local-copy tmp-name1)) + :type tramp-file-missing)) ;; Cleanup. (ignore-errors @@ -1776,19 +1782,23 @@ This checks also `file-name-as-directory', `file-name-directory', (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) (let ((tmp-name (tramp--test-make-temp-name nil quoted))) (unwind-protect - (progn + (with-temp-buffer (write-region "foo" nil tmp-name) - (with-temp-buffer - (insert-file-contents tmp-name) - (should (string-equal (buffer-string) "foo")) - (insert-file-contents tmp-name) - (should (string-equal (buffer-string) "foofoo")) - ;; Insert partly. - (insert-file-contents tmp-name nil 1 3) - (should (string-equal (buffer-string) "oofoofoo")) - ;; Replace. - (insert-file-contents tmp-name nil nil nil 'replace) - (should (string-equal (buffer-string) "foo")))) + (insert-file-contents tmp-name) + (should (string-equal (buffer-string) "foo")) + (insert-file-contents tmp-name) + (should (string-equal (buffer-string) "foofoo")) + ;; Insert partly. + (insert-file-contents tmp-name nil 1 3) + (should (string-equal (buffer-string) "oofoofoo")) + ;; Replace. + (insert-file-contents tmp-name nil nil nil 'replace) + (should (string-equal (buffer-string) "foo")) + ;; Error case. + (delete-file tmp-name) + (should-error + (insert-file-contents tmp-name) + :type tramp-file-missing)) ;; Cleanup. (ignore-errors (delete-file tmp-name)))))) @@ -2681,6 +2691,16 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (string-equal (file-truename tmp-name1) (file-truename tmp-name2))) (should (file-equal-p tmp-name1 tmp-name2)) + ;; Symbolic links could look like a remote file name. + ;; They must be quoted then. + (delete-file tmp-name2) + (make-symbolic-link "/penguin:motd:" tmp-name2) + (should (file-symlink-p tmp-name2)) + (should + (string-equal + (file-truename tmp-name2) + (tramp-compat-file-name-quote + (concat (file-remote-p tmp-name2) "/penguin:motd:")))) ;; `tmp-name3' is a local file name. (make-symbolic-link tmp-name1 tmp-name3) (should (file-symlink-p tmp-name3)) @@ -2698,6 +2718,48 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (delete-file tmp-name2) (delete-file tmp-name3))) + ;; Symbolic links could be nested. + (unwind-protect + (tramp--test-ignore-make-symbolic-link-error + (make-directory tmp-name1) + (should (file-directory-p tmp-name1)) + (let* ((tramp-test-temporary-file-directory + (file-truename tmp-name1)) + (tmp-name2 (tramp--test-make-temp-name nil quoted)) + (tmp-name3 tmp-name2) + (number-nesting 50)) + (dotimes (_ number-nesting) + (make-symbolic-link + tmp-name3 + (setq tmp-name3 (tramp--test-make-temp-name nil quoted)))) + (should + (string-equal + (file-truename tmp-name2) + (file-truename tmp-name3))) + (should-error + (with-temp-buffer (insert-file-contents tmp-name2)) + :type tramp-file-missing) + (should-error + (with-temp-buffer (insert-file-contents tmp-name3)) + :type tramp-file-missing))) + + ;; Cleanup. + (ignore-errors (delete-directory tmp-name1 'recursive))) + + ;; Detect cyclic symbolic links. + (unwind-protect + (tramp--test-ignore-make-symbolic-link-error + (make-symbolic-link tmp-name2 tmp-name1) + (should (file-symlink-p tmp-name1)) + (make-symbolic-link tmp-name1 tmp-name2) + (should (file-symlink-p tmp-name2)) + (should-error (file-truename tmp-name1) :type 'file-error)) + + ;; Cleanup. + (ignore-errors + (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)) @@ -4019,7 +4081,7 @@ process sentinels. They shall not disturb each other." ;; Create temporary buffers. The number of buffers ;; corresponds to the number of processes; it could be ;; increased in order to make pressure on Tramp. - (dotimes (_i number-proc) + (dotimes (_ number-proc) (setq buffers (cons (generate-new-buffer "foo") buffers))) ;; Open asynchronous processes. Set process filter and sentinel.