[Emacs-diffs] master 00d4ba2: Further improvements in Tramp's file name unquoting

[Michael Albinus]

branch: master
commit 00d4ba2794243763b818c013669e36c1d2c7de62
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    Further improvements in Tramp's file name unquoting
    
    * lisp/net/tramp-adb.el (tramp-adb-handle-file-local-copy)
    (tramp-adb-handle-write-region): Unquote localname.
    (tramp-adb-handle-copy-file): Implement direct copy on remote device.
    (tramp-adb-handle-rename-file): Quote arguments, add "-f" to force.
    
    * lisp/net/tramp.el (tramp-file-name-unquote-localname): New defun.
    (tramp-handle-file-name-case-insensitive-p):
    * lisp/net/tramp-gvfs.el (tramp-gvfs-get-file-attributes)
    (tramp-gvfs-connection-mounted-p, tramp-gvfs-mount-spec)
    (tramp-gvfs-maybe-open-connection):
    * lisp/net/tramp-sh.el (tramp-make-copy-program-file-name):
    * lisp/net/tramp-smb.el (tramp-smb-get-share)
    (tramp-smb-get-localname): Use it.
    
    * test/lisp/net/tramp-tests.el (tramp--test-docker-p): New defun.
    (tramp--test-special-characters, tramp-test34-utf8)
    (tramp-test34-utf8-with-stat, tramp-test34-utf8-with-perl)
    (tramp-test34-utf8-with-ls): Use it.
---
 lisp/net/tramp-adb.el        |  105 ++++++++++++++++++++++++++++--------------
 lisp/net/tramp-gvfs.el       |    7 +--
 lisp/net/tramp-sh.el         |   20 +++-----
 lisp/net/tramp-smb.el        |    6 +--
 lisp/net/tramp.el            |    9 +++-
 test/lisp/net/tramp-tests.el |   14 +++++-
 6 files changed, 103 insertions(+), 58 deletions(-)

diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index f03f50b..a4218c2 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -523,6 +523,9 @@ Emacs dired can't find files."
 (defun tramp-adb-handle-delete-directory (directory &optional recursive)
   "Like `delete-directory' for Tramp files."
   (setq directory (expand-file-name directory))
+  (with-parsed-tramp-file-name (file-truename directory) nil
+    (tramp-flush-file-property v (file-name-directory localname))
+    (tramp-flush-directory-property v localname))
   (with-parsed-tramp-file-name directory nil
     (tramp-flush-file-property v (file-name-directory localname))
     (tramp-flush-directory-property v localname)
@@ -578,7 +581,8 @@ Emacs dired can't find files."
       (with-tramp-progress-reporter
          v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
        ;; "adb pull ..." does not always return an error code.
-       (when (or (tramp-adb-execute-adb-command v "pull" localname tmpfile)
+       (when (or (tramp-adb-execute-adb-command
+                  v "pull" (tramp-compat-file-name-unquote localname) tmpfile)
                  (not (file-exists-p tmpfile)))
          (ignore-errors (delete-file tmpfile))
          (tramp-error
@@ -638,7 +642,8 @@ But handle the case, if the \"test\" command is not 
available."
         v 3 (format-message
              "Moving tmp file `%s' to `%s'" tmpfile filename)
        (unwind-protect
-           (when (tramp-adb-execute-adb-command v "push" tmpfile localname)
+           (when (tramp-adb-execute-adb-command
+                  v "push" tmpfile (tramp-compat-file-name-unquote localname))
              (tramp-error v 'file-error "Cannot write: `%s'" filename))
          (delete-file tmpfile)))
 
@@ -681,38 +686,65 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are 
completely ignored."
 
   (if (file-directory-p filename)
       (tramp-file-name-handler 'copy-directory filename newname keep-date t)
-    (with-tramp-progress-reporter
-       (tramp-dissect-file-name
-        (if (tramp-tramp-file-p filename) filename newname))
-       0 (format "Copying %s to %s" filename newname)
-
-      (let ((tmpfile (file-local-copy filename)))
-
-       (if tmpfile
-           ;; Remote filename.
-           (condition-case err
-               (rename-file tmpfile newname ok-if-already-exists)
-             ((error quit)
-              (delete-file tmpfile)
-              (signal (car err) (cdr err))))
-
-         ;; Remote newname.
-         (when (file-directory-p newname)
-           (setq newname
-                 (expand-file-name (file-name-nondirectory filename) newname)))
-
-         (with-parsed-tramp-file-name newname nil
-           (when (and (not ok-if-already-exists)
-                      (file-exists-p newname))
-             (tramp-error v 'file-already-exists newname))
-
-           ;; We must also flush the cache of the directory, because
-           ;; `file-attributes' reads the values from there.
-           (tramp-flush-file-property v (file-name-directory localname))
-           (tramp-flush-file-property v localname)
-           (when (tramp-adb-execute-adb-command v "push" filename localname)
-             (tramp-error
-              v 'file-error "Cannot copy `%s' `%s'" filename newname))))))
+
+    (let ((t1 (tramp-tramp-file-p filename))
+         (t2 (tramp-tramp-file-p newname)))
+      (with-parsed-tramp-file-name (if t1 filename newname) nil
+       (with-tramp-progress-reporter
+           v 0 (format "Copying %s to %s" filename newname)
+
+         (if (and t1 t2 (tramp-equal-remote filename newname))
+             (let ((l1 (file-remote-p filename 'localname))
+                   (l2 (file-remote-p newname 'localname)))
+               (when (and (not ok-if-already-exists)
+                          (file-exists-p newname))
+                 (tramp-error v 'file-already-exists newname))
+               ;; We must also flush the cache of the directory,
+               ;; because `file-attributes' reads the values from
+               ;; there.
+               (tramp-flush-file-property v (file-name-directory l2))
+               (tramp-flush-file-property v l2)
+               ;; Short track.
+               (tramp-adb-barf-unless-okay
+                v (format
+                   "cp -f %s %s"
+                   (tramp-shell-quote-argument l1)
+                   (tramp-shell-quote-argument l2))
+                "Error copying %s to %s" filename newname))
+
+           (let ((tmpfile (file-local-copy filename)))
+
+             (if tmpfile
+                 ;; Remote filename.
+                 (condition-case err
+                     (rename-file tmpfile newname ok-if-already-exists)
+                   ((error quit)
+                    (delete-file tmpfile)
+                    (signal (car err) (cdr err))))
+
+               ;; Remote newname.
+               (when (file-directory-p newname)
+                 (setq newname
+                       (expand-file-name
+                        (file-name-nondirectory filename) newname)))
+
+               (with-parsed-tramp-file-name newname nil
+                 (when (and (not ok-if-already-exists)
+                            (file-exists-p newname))
+                   (tramp-error v 'file-already-exists newname))
+
+                 ;; We must also flush the cache of the directory,
+                 ;; because `file-attributes' reads the values from
+                 ;; there.
+                 (tramp-flush-file-property v (file-name-directory localname))
+                 (tramp-flush-file-property v localname)
+                 (when (tramp-adb-execute-adb-command
+                        v "push"
+                        (tramp-compat-file-name-unquote filename)
+                        (tramp-compat-file-name-unquote localname))
+                   (tramp-error
+                    v 'file-error
+                    "Cannot copy `%s' `%s'" filename newname)))))))))
 
     ;; KEEP-DATE handling.
     (when keep-date
@@ -749,7 +781,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are 
completely ignored."
              (tramp-flush-file-property v l2)
              ;; Short track.
              (tramp-adb-barf-unless-okay
-              v (format "mv %s %s" l1 l2)
+              v (format
+                 "mv -f %s %s"
+                 (tramp-shell-quote-argument l1)
+                 (tramp-shell-quote-argument l2))
               "Error renaming %s to %s" filename newname))
 
          ;; Rename by copy.
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 46f2523..37aba59 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -901,6 +901,7 @@ file names."
   "Return GVFS attributes association list of FILENAME."
   (setq filename (directory-file-name (expand-file-name filename)))
   (with-parsed-tramp-file-name filename nil
+    (setq localname (tramp-compat-file-name-unquote localname))
     (if (or
         (and (string-match "^\\(afp\\|smb\\)$" method)
              (string-match "^/?\\([^/]+\\)$" localname))
@@ -1511,7 +1512,7 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or 
\"[xx:xx:xx:xx:xx:xx]\"."
                (string-equal user (or (tramp-file-name-user vec) ""))
                (string-equal host (tramp-file-name-host vec))
                (string-match (concat "^" (regexp-quote prefix))
-                             (tramp-file-name-localname vec)))
+                             (tramp-file-name-unquote-localname vec)))
           ;; Set prefix, mountpoint and location.
           (unless (string-equal prefix "/")
             (tramp-set-file-property vec "/" "prefix" prefix))
@@ -1535,7 +1536,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"."
         (domain (tramp-file-name-domain vec))
         (host (tramp-file-name-real-host vec))
         (port (tramp-file-name-port vec))
-        (localname (tramp-file-name-localname vec))
+        (localname (tramp-file-name-unquote-localname vec))
         (share (when (string-match "^/?\\([^/]+\\)" localname)
                  (match-string 1 localname)))
         (ssl (if (string-match "^davs" method) "true" "false"))
@@ -1645,7 +1646,7 @@ connection if a previous connection has died for some 
reason."
     (let* ((method (tramp-file-name-method vec))
           (user (tramp-file-name-user vec))
           (host (tramp-file-name-host vec))
-          (localname (tramp-file-name-localname vec))
+          (localname (tramp-file-name-unquote-localname vec))
           (object-path
            (tramp-gvfs-object-path
             (tramp-make-tramp-file-name method user host ""))))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 52746f6..419dccb 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2227,14 +2227,8 @@ the uid and gid from FILENAME."
                            v 'file-error
                            "Unknown operation `%s', must be `copy' or `rename'"
                            op))))
-            (localname1
-             (if t1
-                 (file-remote-p filename 'localname)
-               filename))
-            (localname2
-             (if t2
-                 (file-remote-p newname 'localname)
-               newname))
+            (localname1 (if t1 (file-remote-p filename 'localname) filename))
+            (localname2 (if t2 (file-remote-p newname 'localname) newname))
             (prefix (file-remote-p (if t1 filename newname)))
              cmd-result)
 
@@ -2324,11 +2318,9 @@ the uid and gid from FILENAME."
                     (t2
                      (if (eq op 'copy)
                          (copy-file
-                          localname1 tmpfile t
-                          keep-date preserve-uid-gid)
+                          localname1 tmpfile t keep-date preserve-uid-gid)
                        (tramp-run-real-handler
-                        'rename-file
-                        (list localname1 tmpfile t)))
+                        'rename-file (list localname1 tmpfile t)))
                      ;; We must change the ownership as local user.
                      ;; Since this does not work reliable, we also
                      ;; give read permissions.
@@ -5166,8 +5158,8 @@ Return ATTR."
   (let ((method (tramp-file-name-method vec))
        (user (tramp-file-name-user vec))
        (host (tramp-file-name-real-host vec))
-       (localname (tramp-compat-file-name-unquote
-                   (directory-file-name (tramp-file-name-localname vec)))))
+       (localname
+        (directory-file-name (tramp-file-name-unquote-localname vec))))
     (when (string-match tramp-ipv6-regexp host)
       (setq host (format "[%s]" host)))
     (unless (string-match "ftp$" method)
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 7d0dc66..70b72d8 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1525,8 +1525,7 @@ errors for shares like \"C$/\", which are common in 
Microsoft Windows."
 (defun tramp-smb-get-share (vec)
   "Returns the share name of LOCALNAME."
   (save-match-data
-    (let ((localname
-          (tramp-compat-file-name-unquote (tramp-file-name-localname vec))))
+    (let ((localname (tramp-file-name-unquote-localname vec)))
       (when (string-match "^/?\\([^/]+\\)/" localname)
        (match-string 1 localname)))))
 
@@ -1534,8 +1533,7 @@ errors for shares like \"C$/\", which are common in 
Microsoft Windows."
   "Returns the file name of LOCALNAME.
 If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"."
   (save-match-data
-    (let ((localname
-          (tramp-compat-file-name-unquote (tramp-file-name-localname vec))))
+    (let ((localname (tramp-file-name-unquote-localname vec)))
       (setq
        localname
        (if (string-match "^/?[^/]+\\(/.*\\)" localname)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 100be3a..7987029 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1146,6 +1146,11 @@ entry does not exist, return nil."
               (string-to-number (match-string 2 host)))
          (tramp-get-method-parameter vec 'tramp-default-port)))))
 
+;; The localname can be quoted with "/:".  Extract this.
+(defun tramp-file-name-unquote-localname (vec)
+  "Return unquoted localname component of VEC."
+  (tramp-compat-file-name-unquote (tramp-file-name-localname vec)))
+
 ;;;###tramp-autoload
 (defun tramp-tramp-file-p (name)
   "Return t if NAME is a string with Tramp file name syntax."
@@ -2910,7 +2915,9 @@ User is always nil."
           (with-tramp-connection-property v "case-insensitive"
             ;; The idea is to compare a file with lower case letters
             ;; with the same file with upper case letters.
-            (let ((candidate (directory-file-name filename))
+            (let ((candidate
+                  (tramp-compat-file-name-unquote
+                   (directory-file-name filename)))
                   tmpfile)
               ;; Check, whether we find an existing file with lower case
               ;; letters.  This avoids us to create a temporary file.
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 2d17fa0..e80af42 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2102,6 +2102,12 @@ This tests also `make-symbolic-link', `file-truename' 
and `add-name-to-file'."
 This requires restrictions of file name syntax."
   (tramp-adb-file-name-p tramp-test-temporary-file-directory))
 
+(defun tramp--test-docker-p ()
+  "Check, whether the docker method is used.
+This does not support some special file names."
+  (string-equal
+   "docker" (file-remote-p tramp-test-temporary-file-directory 'method)))
+
 (defun tramp--test-ftp-p ()
   "Check, whether an FTP-like method is used.
 This does not support globbing characters in file names (yet)."
@@ -2293,7 +2299,9 @@ Several special characters do not work properly there."
   (tramp--test-check-files
    (if (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p))
        "foo bar baz"
-     (if (or (tramp--test-adb-p) (eq system-type 'cygwin))
+     (if (or (tramp--test-adb-p)
+            (tramp--test-docker-p)
+            (eq system-type 'cygwin))
         " foo bar baz "
        " foo\tbar baz\t"))
    "$foo$bar$$baz$"
@@ -2404,6 +2412,7 @@ Use the `ls' command."
 (ert-deftest tramp-test34-utf8 ()
   "Check UTF8 encoding in file names and file contents."
   (skip-unless (tramp--test-enabled))
+  (skip-unless (not (tramp--test-docker-p)))
   (skip-unless (not (tramp--test-rsync-p)))
 
   (tramp--test-utf8))
@@ -2413,6 +2422,7 @@ Use the `ls' command."
 Use the `stat' command."
   :tags '(:expensive-test)
   (skip-unless (tramp--test-enabled))
+  (skip-unless (not (tramp--test-docker-p)))
   (skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p))))
   (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
     (skip-unless (tramp-get-remote-stat v)))
@@ -2429,6 +2439,7 @@ Use the `stat' command."
 Use the `perl' command."
   :tags '(:expensive-test)
   (skip-unless (tramp--test-enabled))
+  (skip-unless (not (tramp--test-docker-p)))
   (skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p))))
   (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
     (skip-unless (tramp-get-remote-perl v)))
@@ -2448,6 +2459,7 @@ Use the `perl' command."
 Use the `ls' command."
   :tags '(:expensive-test)
   (skip-unless (tramp--test-enabled))
+  (skip-unless (not (tramp--test-docker-p)))
   (skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p))))
 
   (let ((tramp-connection-properties