procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix further problems with quoted file names in Tramp

Browse source 
* 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.
This commit is contained in:
Michael Albinus 2016-12-09 19:54:20 +01:00
parent 57a77f833e
commit fc0fd24c10
7 changed files with 81 additions and 60 deletions
Download patch file Download diff file Expand all files Collapse all files

24
lisp/net/tramp-cache.el
View file

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

31
lisp/net/tramp-compat.el
View file

@ -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:

1
lisp/net/tramp-gvfs.el
View file

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

14
lisp/net/tramp-sh.el
View file

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

30
lisp/net/tramp-smb.el
View file

@ -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)

27
lisp/net/tramp.el
View file

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