[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master fc0fd24: Fix further problems with quoted file name
|
From: |
Michael Albinus |
|
Subject: |
[Emacs-diffs] master fc0fd24: Fix further problems with quoted file names in Tramp |
|
Date: |
Fri, 9 Dec 2016 18:54:36 +0000 (UTC) |
branch: master
commit fc0fd24c105bde4c001ebebe4b8b7e1f96cd2871
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>
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.
---
lisp/net/tramp-cache.el | 24 ++++++++++++++----------
lisp/net/tramp-compat.el | 31 +++++++++++++++++++++++++++++++
lisp/net/tramp-gvfs.el | 1 +
lisp/net/tramp-sh.el | 14 +++++++-------
lisp/net/tramp-smb.el | 30 ++++++++++++++++++------------
lisp/net/tramp.el | 27 +++------------------------
test/lisp/net/tramp-tests.el | 14 +++++++-------
7 files changed, 81 insertions(+), 60 deletions(-)
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 531044f..0d90017 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -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
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index a079b67..9f1c64d 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -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:
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index d87de46..46f2523 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -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
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index a2949f1..52746f6 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -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 "address@hidden:%s" user host localname)))
- (t (tramp-unquote-shell-quote-argument (format "%s:%s" host
localname))))))
+ (tramp-shell-quote-argument (format "address@hidden:%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."
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index d6d4669..7d0dc66 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -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)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 48ae6e0..100be3a 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -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
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index c2984df..2d17fa0 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -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)))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master fc0fd24: Fix further problems with quoted file names in Tramp,
Michael Albinus <=