[Emacs-diffs] master f5834c9 1/2: Fix problem with trailing slash in Tramp

[Michael Albinus]

branch: master
commit f5834c9ba06529bcd0a6da464f0a808e1be53c5c
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <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'."