Commit fc0fd24c authored by Michael Albinus's avatar Michael Albinus

Fix further problems with quoted file names in Tramp

* lisp/net/tramp.el (tramp-quoted-name-p, tramp-quote-name)
(tramp-unquote-name): Move defsubst ...
* lisp/net/tramp-compat.el (tramp-compat-file-name-quoted-p)
(tramp-compat-file-name-quote)
(tramp-compat-file-name-unquote): ... here. Adapt callees.

* lisp/net/tramp-cache.el (tramp-flush-file-property)
(tramp-flush-directory-property):
* lisp/net/tramp-gvfs.el (tramp-gvfs-url-file-name):
* lisp/net/tramp-sh.el (tramp-make-copy-program-file-name):
* lisp/net/tramp-smb.el (tramp-smb-handle-copy-file)
(tramp-smb-handle-substitute-in-file-name)
(tramp-smb-get-share, tramp-smb-get-localname): Handle quoted files.
parent 57a77f83
......@@ -107,6 +107,7 @@ matching entries of `tramp-connection-properties'."
"Get the PROPERTY of FILE from the cache context of KEY.
Returns DEFAULT if not set."
;; Unify localname. Remove hop from vector.
(setq file (tramp-compat-file-name-unquote file))
(setq key (copy-sequence key))
(aset key 3 (tramp-run-real-handler 'directory-file-name (list file)))
(aset key 4 nil)
......@@ -140,6 +141,7 @@ Returns DEFAULT if not set."
"Set the PROPERTY of FILE to VALUE, in the cache context of KEY.
Returns VALUE."
;; Unify localname. Remove hop from vector.
(setq file (tramp-compat-file-name-unquote file))
(setq key (copy-sequence key))
(aset key 3 (tramp-run-real-handler 'directory-file-name (list file)))
(aset key 4 nil)
......@@ -159,28 +161,26 @@ Returns VALUE."
(let* ((file (tramp-run-real-handler
'directory-file-name (list file)))
(truename (tramp-get-file-property key file "file-truename" nil)))
;; Remove file properties of symlinks.
(when (and (stringp truename)
(not (string-equal file (directory-file-name truename))))
(tramp-flush-file-property key truename))
;; Unify localname. Remove hop from vector.
(setq file (tramp-compat-file-name-unquote file))
(setq key (copy-sequence key))
(aset key 3 file)
(aset key 4 nil)
(tramp-message key 8 "%s" file)
(remhash key tramp-cache-data)))
(remhash key tramp-cache-data)
;; Remove file properties of symlinks.
(when (and (stringp truename)
(not (string-equal file (directory-file-name truename))))
(tramp-flush-file-property key truename))))
;;;###tramp-autoload
(defun tramp-flush-directory-property (key directory)
"Remove all properties of DIRECTORY in the cache context of KEY.
Remove also properties of all files in subdirectories."
(setq directory (tramp-compat-file-name-unquote directory))
(let* ((directory (tramp-run-real-handler
'directory-file-name (list directory)))
(truename (tramp-get-file-property key directory "file-truename" nil)))
;; Remove file properties of symlinks.
(when (and (stringp truename)
(not (string-equal directory (directory-file-name truename))))
(tramp-flush-directory-property key truename))
(tramp-message key 8 "%s" directory)
(maphash
(lambda (key _value)
......@@ -188,7 +188,11 @@ Remove also properties of all files in subdirectories."
(string-match (regexp-quote directory)
(tramp-file-name-localname key)))
(remhash key tramp-cache-data)))
tramp-cache-data)))
tramp-cache-data)
;; Remove file properties of symlinks.
(when (and (stringp truename)
(not (string-equal directory (directory-file-name truename))))
(tramp-flush-directory-property key truename))))
;; Reverting or killing a buffer should also flush file properties.
;; They could have been changed outside Tramp. In eshell, "ls" would
......
......@@ -347,6 +347,37 @@ This is a string of ten letters or dashes as in ls -l."
(unload-feature 'tramp-loaddefs 'force)
(unload-feature 'tramp-compat 'force)))
;; `file-name-quoted-p', `file-name-quote' and `file-name-unquote' are
;; introduced in Emacs 26.
(if (fboundp 'file-name-quoted-p)
(defalias 'tramp-compat-file-name-quoted-p 'file-name-quoted-p)
(defsubst tramp-compat-file-name-quoted-p (name)
"Whether NAME is quoted with prefix \"/:\".
If NAME is a remote file name, check the local part of NAME."
(string-match "^/:" (or (file-remote-p name 'localname) name))))
(if (fboundp 'file-name-quote)
(defalias 'tramp-compat-file-name-quote 'file-name-quote)
(defsubst tramp-compat-file-name-quote (name)
"Add the quotation prefix \"/:\" to file NAME.
If NAME is a remote file name, the local part of NAME is quoted."
(concat
(file-remote-p name) "/:" (or (file-remote-p name 'localname) name))))
(if (fboundp 'file-name-unquote)
(defalias 'tramp-compat-file-name-unquote 'file-name-unquote)
(defsubst tramp-compat-file-name-unquote (name)
"Remove quotation prefix \"/:\" from file NAME.
If NAME is a remote file name, the local part of NAME is unquoted."
(save-match-data
(let ((localname (or (file-remote-p name 'localname) name)))
(when (tramp-compat-file-name-quoted-p localname)
(setq
localname
(replace-match
(if (= (length localname) 2) "/" "") nil t localname)))
(concat (file-remote-p name) localname)))))
(provide 'tramp-compat)
;;; TODO:
......
......@@ -1232,6 +1232,7 @@ file-notify events."
(defun tramp-gvfs-url-file-name (filename)
"Return FILENAME in URL syntax."
;; "/" must NOT be hexlified.
(setq filename (tramp-compat-file-name-unquote filename))
(let ((url-unreserved-chars (cons ?/ url-unreserved-chars))
result)
(setq
......
......@@ -1147,8 +1147,8 @@ target of the symlink differ."
method user host
(with-tramp-file-property v localname "file-truename"
(let ((result nil) ; result steps in reverse order
(quoted (tramp-quoted-name-p localname))
(localname (tramp-unquote-name localname)))
(quoted (tramp-compat-file-name-quoted-p localname))
(localname (tramp-compat-file-name-unquote localname)))
(tramp-message v 4 "Finding true name for `%s'" filename)
(cond
;; Use GNU readlink --canonicalize-missing where available.
......@@ -1243,7 +1243,7 @@ target of the symlink differ."
(when (string= "" result)
(setq result "/")))))
(when quoted (setq result (tramp-quote-name result)))
(when quoted (setq result (tramp-compat-file-name-quote result)))
(tramp-message v 4 "True name of `%s' is `%s'" localname result)
result))))
......@@ -5166,7 +5166,8 @@ Return ATTR."
(let ((method (tramp-file-name-method vec))
(user (tramp-file-name-user vec))
(host (tramp-file-name-real-host vec))
(localname (directory-file-name (tramp-file-name-localname vec))))
(localname (tramp-compat-file-name-unquote
(directory-file-name (tramp-file-name-localname vec)))))
(when (string-match tramp-ipv6-regexp host)
(setq host (format "[%s]" host)))
(unless (string-match "ftp$" method)
......@@ -5175,9 +5176,8 @@ Return ATTR."
((tramp-get-method-parameter vec 'tramp-remote-copy-program)
localname)
((not (zerop (length user)))
(tramp-unquote-shell-quote-argument
(format "%s@%s:%s" user host localname)))
(t (tramp-unquote-shell-quote-argument (format "%s:%s" host localname))))))
(tramp-shell-quote-argument (format "%s@%s:%s" user host localname)))
(t (tramp-shell-quote-argument (format "%s:%s" host localname))))))
(defun tramp-method-out-of-band-p (vec size)
"Return t if this is an out-of-band method, nil otherwise."
......
......@@ -604,7 +604,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
v 'file-error "Target `%s' must contain a share name" newname))
(unless (tramp-smb-send-command
v (format "put \"%s\" \"%s\""
filename (tramp-smb-get-localname v)))
(tramp-compat-file-name-unquote filename)
(tramp-smb-get-localname v)))
(tramp-error
v 'file-error "Cannot copy `%s' to `%s'" filename newname))))))
......@@ -1463,15 +1464,18 @@ target of the symlink differ."
"Like `handle-substitute-in-file-name' for Tramp files.
\"//\" substitutes only in the local filename part. Catches
errors for shares like \"C$/\", which are common in Microsoft Windows."
(with-parsed-tramp-file-name filename nil
;; Ignore in LOCALNAME everything before "//".
(when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
(setq filename
(concat (file-remote-p filename)
(replace-match "\\1" nil nil localname)))))
(condition-case nil
(tramp-run-real-handler 'substitute-in-file-name (list filename))
(error filename)))
;; Check, whether the local part is a quoted file name.
(if (tramp-compat-file-name-quoted-p filename)
filename
(with-parsed-tramp-file-name filename nil
;; Ignore in LOCALNAME everything before "//".
(when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
(setq filename
(concat (file-remote-p filename)
(replace-match "\\1" nil nil localname)))))
(condition-case nil
(tramp-run-real-handler 'substitute-in-file-name (list filename))
(error filename))))
(defun tramp-smb-handle-write-region
(start end filename &optional append visit lockname confirm)
......@@ -1521,7 +1525,8 @@ 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-file-name-localname vec)))
(let ((localname
(tramp-compat-file-name-unquote (tramp-file-name-localname vec))))
(when (string-match "^/?\\([^/]+\\)/" localname)
(match-string 1 localname)))))
......@@ -1529,7 +1534,8 @@ 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-file-name-localname vec)))
(let ((localname
(tramp-compat-file-name-unquote (tramp-file-name-localname vec))))
(setq
localname
(if (string-match "^/?[^/]+\\(/.*\\)" localname)
......
......@@ -1679,27 +1679,6 @@ FILE must be a local file name on a connection identified via VEC."
(font-lock-add-keywords
'emacs-lisp-mode '("\\<with-tramp-connection-property\\>"))
(defsubst tramp-quoted-name-p (name)
"Whether NAME is quoted with prefix \"/:\".
If NAME is a remote file name, check the local part of NAME."
(string-match "^/:" (or (file-remote-p name 'localname) name)))
(defsubst tramp-quote-name (name)
"Add the quotation prefix \"/:\" to file NAME.
If NAME is a remote file name, the local part of NAME is quoted."
(concat (file-remote-p name) "/:" (or (file-remote-p name 'localname) name)))
(defsubst tramp-unquote-name (name)
"Remove quotation prefix \"/:\" from file NAME.
If NAME is a remote file name, the local part of NAME is unquoted."
(save-match-data
(let ((localname (or (file-remote-p name 'localname) name)))
(when (tramp-quoted-name-p localname)
(setq
localname
(replace-match (if (= (length localname) 2) "/" "") nil t localname)))
(concat (file-remote-p name) localname))))
(defun tramp-drop-volume-letter (name)
"Cut off unnecessary drive letter from file NAME.
The functions `tramp-*-handle-expand-file-name' call `expand-file-name'
......@@ -3345,7 +3324,7 @@ User is always nil."
"Like `substitute-in-file-name' for Tramp files.
\"//\" and \"/~\" substitute only in the local filename part."
;; Check, whether the local part is a quoted file name.
(if (tramp-quoted-name-p filename)
(if (tramp-compat-file-name-quoted-p filename)
filename
;; First, we must replace environment variables.
(setq filename (tramp-replace-environment-variables filename))
......@@ -4105,7 +4084,7 @@ this file, if that variable is non-nil."
("|" . "__")
("[" . "_l")
("]" . "_r"))
(tramp-unquote-name (buffer-file-name)))
(tramp-compat-file-name-unquote (buffer-file-name)))
tramp-auto-save-directory))))
;; Run plain `make-auto-save-file-name'.
(tramp-run-real-handler 'make-auto-save-file-name nil)))
......@@ -4307,7 +4286,7 @@ T1 and T2 are time values (as returned by `current-time' for example)."
(defun tramp-unquote-shell-quote-argument (s)
"Remove quotation prefix \"/:\" from string S, and quote it then for shell."
(shell-quote-argument (tramp-unquote-name s)))
(shell-quote-argument (tramp-compat-file-name-unquote s)))
;; Currently (as of Emacs 20.5), the function `shell-quote-argument'
;; does not deal well with newline characters. Newline is replaced by
......
......@@ -116,7 +116,7 @@ being the result.")
If LOCAL is non-nil, a local file is created.
If QUOTED is non-nil, the local part of the file is quoted."
(funcall
(if quoted 'tramp-quote-name 'identity)
(if quoted 'tramp-compat-file-name-quote 'identity)
(expand-file-name
(make-temp-name "tramp-test")
(if local temporary-file-directory tramp-test-temporary-file-directory))))
......@@ -1252,7 +1252,7 @@ This tests also `file-readable-p', `file-regular-p' and
(should
(string-equal
(funcall
(if quoted 'tramp-quote-name 'identity)
(if quoted 'tramp-compat-file-name-quote 'identity)
(car attr))
(file-remote-p (file-truename tmp-name1) 'localname)))
(delete-file tmp-name2))
......@@ -2010,7 +2010,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(string-equal
(make-auto-save-file-name)
(funcall
(if quoted 'tramp-quote-name 'identity)
(if quoted 'tramp-compat-file-name-quote 'identity)
(expand-file-name
(format "#%s#" (file-name-nondirectory tmp-name1))
tramp-test-temporary-file-directory))))))
......@@ -2033,7 +2033,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
("|" . "__")
("[" . "_l")
("]" . "_r"))
(tramp-unquote-name tmp-name1)))
(tramp-compat-file-name-unquote tmp-name1)))
tmp-name2)))
(should (file-directory-p tmp-name2))))
......@@ -2056,7 +2056,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
("|" . "__")
("[" . "_l")
("]" . "_r"))
(tramp-unquote-name tmp-name1)))
(tramp-compat-file-name-unquote tmp-name1)))
tmp-name2)))
(should (file-directory-p tmp-name2)))))
......@@ -2188,7 +2188,7 @@ Several special characters do not work properly there."
(should
(string-equal
(funcall
(if quoted 'tramp-quote-name 'identity)
(if quoted 'tramp-compat-file-name-quote 'identity)
(car (file-attributes file3)))
(file-remote-p (file-truename file1) 'localname)))
;; Check file contents.
......@@ -2264,7 +2264,7 @@ Several special characters do not work properly there."
(should
(string-equal
(funcall
(if quoted 'tramp-quote-name 'identity)
(if quoted 'tramp-compat-file-name-quote 'identity)
(cadr (car (directory-files-and-attributes
file1 nil (regexp-quote elt1)))))
(file-remote-p (file-truename file2) 'localname)))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment