From: Michael Albinus Date: Fri, 9 Dec 2016 18:54:20 +0000 (+0100) Subject: Fix further problems with quoted file names in Tramp X-Git-Tag: emacs-26.0.90~1145 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=fc0fd24c105bde4c001ebebe4b8b7e1f96cd2871;p=emacs.git 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. --- diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 531044fddfd..0d90017651b 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 a079b670641..9f1c64dd100 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 d87de467c67..46f252306ec 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 a2949f1f204..52746f680bd 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 "%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." diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index d6d4669c912..7d0dc664f8d 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 48ae6e06000..100be3ac541 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 '("\\")) -(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 c2984dfc776..2d17fa08ca5 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)))