diff options
| -rw-r--r-- | lisp/net/tramp-adb.el | 105 | ||||
| -rw-r--r-- | lisp/net/tramp-gvfs.el | 7 | ||||
| -rw-r--r-- | lisp/net/tramp-sh.el | 20 | ||||
| -rw-r--r-- | lisp/net/tramp-smb.el | 6 | ||||
| -rw-r--r-- | lisp/net/tramp.el | 9 | ||||
| -rw-r--r-- | 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 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 |