From: Michael Albinus <michael.albinus@gmx.de>
Date: Mon, 12 Dec 2016 10:12:34 +0000 (+0100)
Subject: Further improvements in Tramp's file name unquoting
X-Git-Tag: emacs-26.0.90~1127
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=00d4ba2794243763b818c013669e36c1d2c7de62;p=emacs.git

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.
---

diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index f03f50bb009..a4218c28ab3 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 46f252306ec..37aba59e12e 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 52746f680bd..419dccb47e0 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 7d0dc664f8d..70b72d82f54 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 100be3ac541..7987029dc44 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 2d17fa08ca5..e80af422244 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