]> git.eshelyaron.com Git - emacs.git/commitdiff
Fix problem with trailing slash in Tramp
authorMichael Albinus <michael.albinus@gmx.de>
Mon, 26 Mar 2018 12:33:24 +0000 (14:33 +0200)
committerAndrew G Cohen <cohen@andy.bu.edu>
Tue, 11 Dec 2018 06:18:31 +0000 (14:18 +0800)
* 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
lisp/net/tramp-sh.el
lisp/net/tramp.el
test/lisp/net/tramp-tests.el

index 7a0ea71aee9d3608654082cc9b0a1875993fb0c3..fbf6196ca46cf3d390077e4d51379fd0a1794261 100644 (file)
@@ -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."
index 4d7359a4c9c22f3f0495f79bb204f35b925840d8..4cdc39e0b6ac88ed0504b8ef50a0b00924bb5bd2 100644 (file)
@@ -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.
 
index 255c58e48f594a951b867258833767bb1be1df90..4497802d7709ca6531bbafa6847e77d6c664ec8d 100644 (file)
@@ -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."
index 8e21f5220fcecb511f0b83885666a3361891acf1..5851840d0094fcc7fadb526ff099978cad656872 100644 (file)
@@ -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'."