[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] feature/gnus-select fdbaac5 213/218: Fix problem with trai
From: |
Andrew G Cohen |
Subject: |
[Emacs-diffs] feature/gnus-select fdbaac5 213/218: Fix problem with trailing slash in Tramp |
Date: |
Fri, 14 Dec 2018 03:35:46 -0500 (EST) |
branch: feature/gnus-select
commit fdbaac529e2be9a81568890eaa4168de42172115
Author: Michael Albinus <address@hidden>
Commit: Andrew G Cohen <address@hidden>
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 7a0ea71..fbf6196 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 4d7359a..4cdc39e 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 255c58e..4497802 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 8e21f52..5851840 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'."
- [Emacs-diffs] feature/gnus-select 4fdc730 177/218: sql.el defcustom fixes, (continued)
- [Emacs-diffs] feature/gnus-select 4fdc730 177/218: sql.el defcustom fixes, Andrew G Cohen, 2018/12/14
- [Emacs-diffs] feature/gnus-select fe87972 186/218: * doc/emacs/trouble.texi: Fix location of `emacs-version' index., Andrew G Cohen, 2018/12/14
- [Emacs-diffs] feature/gnus-select 21aa752 184/218: Make update_autogen work in git worktrees, Andrew G Cohen, 2018/12/14
- [Emacs-diffs] feature/gnus-select 7985c87 188/218: * src/alloc.c: Avoid O(N²) complexity when unchaining markers (bug#24548)., Andrew G Cohen, 2018/12/14
- [Emacs-diffs] feature/gnus-select 1a1bb0c 185/218: Explain more about (defvar foo) form (Bug#18059), Andrew G Cohen, 2018/12/14
- [Emacs-diffs] feature/gnus-select d46646d 195/218: Replace cl in some obsolete files, Andrew G Cohen, 2018/12/14
- [Emacs-diffs] feature/gnus-select e70347a 202/218: Limit build load, Andrew G Cohen, 2018/12/14
- [Emacs-diffs] feature/gnus-select f06346b 198/218: Clarify syntax of radixed integers, Andrew G Cohen, 2018/12/14
- [Emacs-diffs] feature/gnus-select 7bb9822 203/218: Remove variables labeled as obsolete that do nothing, Andrew G Cohen, 2018/12/14
- [Emacs-diffs] feature/gnus-select 6d35e8a 183/218: Quieten cl-lib related compiler warnings, Andrew G Cohen, 2018/12/14
- [Emacs-diffs] feature/gnus-select fdbaac5 213/218: Fix problem with trailing slash in Tramp,
Andrew G Cohen <=
- [Emacs-diffs] feature/gnus-select 29d2a98 214/218: * src/marker.c: Try and speed up byte<->char conversion with many markers., Andrew G Cohen, 2018/12/14
- [Emacs-diffs] feature/gnus-select 5a33078 217/218: Trivial fixes for last changes to package.el and marker.c, Andrew G Cohen, 2018/12/14
- [Emacs-diffs] feature/gnus-select 491c4c3 201/218: Ensure configure is running if necessary, Andrew G Cohen, 2018/12/14
- [Emacs-diffs] feature/gnus-select 3cd3c00 210/218: Allow `&rest' or `&optional' without following variable (Bug#29165), Andrew G Cohen, 2018/12/14
- [Emacs-diffs] feature/gnus-select fe90b22 215/218: * lisp/emacs-lisp/package.el: New quickstart feature, Andrew G Cohen, 2018/12/14
- [Emacs-diffs] feature/gnus-select fe4af1c 126/218: Normalize and fix some mistakes in NS-related commentary, Andrew G Cohen, 2018/12/14
- [Emacs-diffs] feature/gnus-select bdea39b 190/218: Instrument tramp-test39-utf8, Andrew G Cohen, 2018/12/14
- [Emacs-diffs] feature/gnus-select 5a4b225 199/218: Quieten lisp/obsolete compilation, Andrew G Cohen, 2018/12/14
- [Emacs-diffs] feature/gnus-select 49b7f74 205/218: * lisp/vc/vc.el (vc-initial-comment): Remove var unused since 23.2., Andrew G Cohen, 2018/12/14
- [Emacs-diffs] feature/gnus-select cf14b56 207/218: Reduce build load, Andrew G Cohen, 2018/12/14