Commit 88006cf5 authored by Michael Albinus's avatar Michael Albinus
Browse files

Quote file names properly in Tramp

* lisp/net/tramp.el (tramp-handle-file-truename)
(tramp-handle-insert-directory):
* lisp/net/tramp-adb.el (tramp-adb-handle-file-truename):
* lisp/net/tramp-sh.el (tramp-sh-handle-file-truename)
(tramp-sh-handle-insert-directory):
* lisp/net/tramp-smb.el (tramp-smb-handle-insert-directory):
* lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-file-truename):
Use `tramp-compat-directory-name-p'.

* lisp/net/tramp.el (tramp-drop-volume-letter)
(tramp-handle-file-truename):
* lisp/net/tramp-adb.el (tramp-adb-handle-file-truename):
* lisp/net/tramp-sh.el (tramp-sh-handle-make-symbolic-link)
(tramp-sh-handle-file-truename):
* lisp/net/tramp-smb.el (tramp-smb-handle-make-symbolic-link):
* lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-file-truename):
(tramp-sudoedit-handle-make-symbolic-link): Quote properly.

* lisp/net/tramp-compat.el (tramp-compat-file-name-quote)
(tramp-compat-file-name-unquote): Add optional argument TOP.
parent f7b5e7d7
Pipeline #2818 failed with stage
in 90 minutes and 1 second
......@@ -232,96 +232,100 @@ pass to the OPERATION."
;; code could be shared?
(defun tramp-adb-handle-file-truename (filename)
"Like `file-truename' for Tramp files."
;; Preserve trailing "/".
;; Preserve trailing "/".
(funcall
(if (string-equal (file-name-nondirectory filename) "")
(if (tramp-compat-directory-name-p filename)
#'file-name-as-directory #'identity)
(with-parsed-tramp-file-name (expand-file-name filename) nil
(tramp-make-tramp-file-name
v
(with-tramp-file-property v localname "file-truename"
(let ((result nil) ; result steps in reverse order
(quoted (tramp-compat-file-name-quoted-p localname)))
(tramp-message v 4 "Finding true name for `%s'" filename)
(let* ((steps (split-string localname "/" 'omit))
(localnamedir (tramp-run-real-handler
'file-name-as-directory (list localname)))
(is-dir (string= localname localnamedir))
(thisstep nil)
(numchase 0)
;; Don't make the following value larger than
;; necessary. People expect an error message in a
;; timely fashion when something is wrong; otherwise
;; they might think that Emacs is hung. Of course,
;; correctness has to come first.
(numchase-limit 20)
symlink-target)
(while (and steps (< numchase numchase-limit))
(setq thisstep (pop steps))
(tramp-message
v 5 "Check %s"
(string-join
(append '("") (reverse result) (list thisstep)) "/"))
(setq symlink-target
(tramp-compat-file-attribute-type
(file-attributes
(tramp-make-tramp-file-name
v
(string-join
(append '("") (reverse result) (list thisstep)) "/")))))
(cond ((string= "." thisstep)
(tramp-message v 5 "Ignoring step `.'"))
((string= ".." thisstep)
(tramp-message v 5 "Processing step `..'")
(pop result))
((stringp symlink-target)
;; It's a symlink, follow it.
(tramp-message v 5 "Follow symlink to %s" symlink-target)
(setq numchase (1+ numchase))
(when (file-name-absolute-p symlink-target)
(setq result nil))
;; If the symlink was absolute, we'll get a string
;; like "/user@host:/some/target"; extract the
;; "/some/target" part from it.
(when (tramp-tramp-file-p symlink-target)
(unless (tramp-equal-remote filename symlink-target)
(tramp-error
v 'file-error
"Symlink target `%s' on wrong host" symlink-target))
(setq symlink-target localname))
(setq steps
(append (split-string symlink-target "/" 'omit)
steps)))
(t
;; It's a file.
(setq result (cons thisstep result)))))
(when (>= numchase numchase-limit)
(tramp-error
v 'file-error
"Maximum number (%d) of symlinks exceeded" numchase-limit))
(setq result (reverse result))
;; Combine list to form string.
(setq result
(if result
(string-join (cons "" result) "/")
"/"))
(when (and is-dir (or (string-empty-p result)
(not (string= (substring result -1) "/"))))
(setq result (concat result "/"))))
;; Detect cycle.
(when (and (file-symlink-p filename)
(string-equal result localname))
(tramp-error
v 'file-error
"Apparent cycle of symbolic links for %s" filename))
;; If the resulting localname looks remote, we must quote it
;; for security reasons.
(when (or quoted (file-remote-p result))
(let (file-name-handler-alist)
(setq result (tramp-compat-file-name-quote result))))
(tramp-message v 4 "True name of `%s' is `%s'" localname result)
result))))))
;; Quote properly.
(funcall
(if (tramp-compat-file-name-quoted-p filename)
#'tramp-compat-file-name-quote #'identity)
(with-parsed-tramp-file-name
(tramp-compat-file-name-unquote (expand-file-name filename)) nil
(tramp-make-tramp-file-name
v
(with-tramp-file-property v localname "file-truename"
(let (result) ; result steps in reverse order
(tramp-message v 4 "Finding true name for `%s'" filename)
(let* ((steps (split-string localname "/" 'omit))
(localnamedir (tramp-run-real-handler
'file-name-as-directory (list localname)))
(is-dir (string= localname localnamedir))
(thisstep nil)
(numchase 0)
;; Don't make the following value larger than
;; necessary. People expect an error message in a
;; timely fashion when something is wrong; otherwise
;; they might think that Emacs is hung. Of course,
;; correctness has to come first.
(numchase-limit 20)
symlink-target)
(while (and steps (< numchase numchase-limit))
(setq thisstep (pop steps))
(tramp-message
v 5 "Check %s"
(string-join
(append '("") (reverse result) (list thisstep)) "/"))
(setq symlink-target
(tramp-compat-file-attribute-type
(file-attributes
(tramp-make-tramp-file-name
v
(string-join
(append
'("") (reverse result) (list thisstep)) "/")))))
(cond ((string= "." thisstep)
(tramp-message v 5 "Ignoring step `.'"))
((string= ".." thisstep)
(tramp-message v 5 "Processing step `..'")
(pop result))
((stringp symlink-target)
;; It's a symlink, follow it.
(tramp-message v 5 "Follow symlink to %s" symlink-target)
(setq numchase (1+ numchase))
(when (file-name-absolute-p symlink-target)
(setq result nil))
;; If the symlink was absolute, we'll get a string
;; like "/user@host:/some/target"; extract the
;; "/some/target" part from it.
(when (tramp-tramp-file-p symlink-target)
(unless (tramp-equal-remote filename symlink-target)
(tramp-error
v 'file-error
"Symlink target `%s' on wrong host" symlink-target))
(setq symlink-target localname))
(setq steps
(append (split-string symlink-target "/" 'omit)
steps)))
(t
;; It's a file.
(setq result (cons thisstep result)))))
(when (>= numchase numchase-limit)
(tramp-error
v 'file-error
"Maximum number (%d) of symlinks exceeded" numchase-limit))
(setq result (reverse result))
;; Combine list to form string.
(setq result
(if result
(string-join (cons "" result) "/")
"/"))
(when (and is-dir (or (string-empty-p result)
(not (string= (substring result -1) "/"))))
(setq result (concat result "/"))))
;; Detect cycle.
(when (and (file-symlink-p filename)
(string-equal result localname))
(tramp-error
v 'file-error
"Apparent cycle of symbolic links for %s" filename))
;; If the resulting localname looks remote, we must quote it
;; for security reasons.
(when (file-remote-p result)
(setq result (tramp-compat-file-name-quote result 'top)))
(tramp-message v 4 "True name of `%s' is `%s'" localname result)
result)))))))
(defun tramp-adb-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
......
......@@ -227,24 +227,31 @@ If NAME is a remote file name and TOP is nil, check the local part of NAME."
(string-prefix-p "/:" (tramp-compat-file-local-name name))))))
(defalias 'tramp-compat-file-name-quote
(if (fboundp 'file-name-quote)
(if (and
(fboundp 'file-name-quote)
(equal (tramp-compat-funcall 'func-arity #'file-name-quote) '(1 . 2)))
#'file-name-quote
(lambda (name)
(lambda (name &optional top)
"Add the quotation prefix \"/:\" to file NAME.
If NAME is a remote file name, the local part of NAME is quoted."
(if (tramp-compat-file-name-quoted-p name)
name
(concat
(file-remote-p name) "/:" (tramp-compat-file-local-name name))))))
If NAME is a remote file name and TOP is nil, the local part of NAME is quoted."
(let ((file-name-handler-alist (unless top file-name-handler-alist)))
(if (tramp-compat-file-name-quoted-p name top)
name
(concat
(file-remote-p name) "/:" (tramp-compat-file-local-name name)))))))
(defalias 'tramp-compat-file-name-unquote
(if (fboundp 'file-name-unquote)
(if (and
(fboundp 'file-name-unquote)
(equal (tramp-compat-funcall 'func-arity #'file-name-unquote) '(1 . 2)))
#'file-name-unquote
(lambda (name)
(lambda (name &optional top)
"Remove quotation prefix \"/:\" from file NAME.
If NAME is a remote file name, the local part of NAME is unquoted."
(let ((localname (tramp-compat-file-local-name name)))
(when (tramp-compat-file-name-quoted-p localname)
If NAME is a remote file name and TOP is nil, the local part of
NAME is unquoted."
(let* ((file-name-handler-alist (unless top file-name-handler-alist))
(localname (tramp-compat-file-local-name name)))
(when (tramp-compat-file-name-quoted-p localname top)
(setq
localname (if (= (length localname) 2) "/" (substring localname 2))))
(concat (file-remote-p name) localname)))))
......
......@@ -1044,8 +1044,7 @@ component is used as the target of the symlink."
;; If TARGET is still remote, quote it.
(if (tramp-tramp-file-p target)
(make-symbolic-link
(let (file-name-handler-alist) (tramp-compat-file-name-quote target))
(make-symbolic-link (tramp-compat-file-name-quote target 'top)
linkname ok-if-already-exists)
(let ((ln (tramp-get-remote-ln v))
......@@ -1090,108 +1089,113 @@ component is used as the target of the symlink."
(defun tramp-sh-handle-file-truename (filename)
"Like `file-truename' for Tramp files."
;; Preserve trailing "/".
;; Preserve trailing "/".
(funcall
(if (string-equal (file-name-nondirectory filename) "")
(if (tramp-compat-directory-name-p filename)
#'file-name-as-directory #'identity)
(with-parsed-tramp-file-name (expand-file-name filename) nil
(tramp-make-tramp-file-name
v
(with-tramp-file-property v localname "file-truename"
(let ((result nil) ; result steps in reverse order
(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.
((tramp-get-remote-readlink v)
(tramp-send-command-and-check
v
(format "%s --canonicalize-missing %s"
(tramp-get-remote-readlink v)
(tramp-shell-quote-argument localname)))
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(setq result (buffer-substring (point-min) (point-at-eol)))))
;; Use Perl implementation.
((and (tramp-get-remote-perl v)
(tramp-get-connection-property v "perl-file-spec" nil)
(tramp-get-connection-property v "perl-cwd-realpath" nil))
(tramp-maybe-send-script
v tramp-perl-file-truename "tramp_perl_file_truename")
(setq result
(tramp-send-command-and-read
v
(format "tramp_perl_file_truename %s"
(tramp-shell-quote-argument localname)))))
;; Do it yourself.
(t (let ((steps (split-string localname "/" 'omit))
(thisstep nil)
(numchase 0)
;; Don't make the following value larger than
;; necessary. People expect an error message in a
;; timely fashion when something is wrong;
;; otherwise they might think that Emacs is hung.
;; Of course, correctness has to come first.
(numchase-limit 20)
symlink-target)
(while (and steps (< numchase numchase-limit))
(setq thisstep (pop steps))
(tramp-message
v 5 "Check %s"
(string-join
(append '("") (reverse result) (list thisstep)) "/"))
(setq symlink-target
(tramp-compat-file-attribute-type
(file-attributes
(tramp-make-tramp-file-name
v
(string-join
(append '("") (reverse result) (list thisstep)) "/")
'nohop))))
(cond ((string= "." thisstep)
(tramp-message v 5 "Ignoring step `.'"))
((string= ".." thisstep)
(tramp-message v 5 "Processing step `..'")
(pop result))
((stringp symlink-target)
;; It's a symlink, follow it.
(tramp-message
v 5 "Follow symlink to %s" symlink-target)
(setq numchase (1+ numchase))
(when (file-name-absolute-p symlink-target)
(setq result nil))
(setq steps
(append
(split-string symlink-target "/" 'omit) steps)))
(t
;; It's a file.
(setq result (cons thisstep result)))))
(when (>= numchase numchase-limit)
(tramp-error
v 'file-error
"Maximum number (%d) of symlinks exceeded" numchase-limit))
(setq result (reverse result))
;; Combine list to form string.
(setq result (if result (string-join (cons "" result) "/") "/"))
(when (string-empty-p result) (setq result "/")))))
;; Detect cycle.
(when (and (file-symlink-p filename)
(string-equal result localname))
(tramp-error
v 'file-error
"Apparent cycle of symbolic links for %s" filename))
;; If the resulting localname looks remote, we must quote it
;; for security reasons.
(when (or quoted (file-remote-p result))
(let (file-name-handler-alist)
(setq result (tramp-compat-file-name-quote result))))
(tramp-message v 4 "True name of `%s' is `%s'" localname result)
result))
'nohop))))
;; Quote properly.
(funcall
(if (tramp-compat-file-name-quoted-p filename)
#'tramp-compat-file-name-quote #'identity)
(with-parsed-tramp-file-name
(tramp-compat-file-name-unquote (expand-file-name filename)) nil
(tramp-make-tramp-file-name
v
(with-tramp-file-property v localname "file-truename"
(let (result) ; result steps in reverse order
(tramp-message v 4 "Finding true name for `%s'" filename)
(cond
;; Use GNU readlink --canonicalize-missing where available.
((tramp-get-remote-readlink v)
(tramp-send-command-and-check
v
(format "%s --canonicalize-missing %s"
(tramp-get-remote-readlink v)
(tramp-shell-quote-argument localname)))
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(setq result (buffer-substring (point-min) (point-at-eol)))))
;; Use Perl implementation.
((and (tramp-get-remote-perl v)
(tramp-get-connection-property v "perl-file-spec" nil)
(tramp-get-connection-property v "perl-cwd-realpath" nil))
(tramp-maybe-send-script
v tramp-perl-file-truename "tramp_perl_file_truename")
(setq result
(tramp-send-command-and-read
v
(format "tramp_perl_file_truename %s"
(tramp-shell-quote-argument localname)))))
;; Do it yourself.
(t (let ((steps (split-string localname "/" 'omit))
(thisstep nil)
(numchase 0)
;; Don't make the following value larger than
;; necessary. People expect an error message in a
;; timely fashion when something is wrong;
;; otherwise they might think that Emacs is hung.
;; Of course, correctness has to come first.
(numchase-limit 20)
symlink-target)
(while (and steps (< numchase numchase-limit))
(setq thisstep (pop steps))
(tramp-message
v 5 "Check %s"
(string-join
(append '("") (reverse result) (list thisstep)) "/"))
(setq symlink-target
(tramp-compat-file-attribute-type
(file-attributes
(tramp-make-tramp-file-name
v
(string-join
(append
'("") (reverse result) (list thisstep)) "/")
'nohop))))
(cond ((string= "." thisstep)
(tramp-message v 5 "Ignoring step `.'"))
((string= ".." thisstep)
(tramp-message v 5 "Processing step `..'")
(pop result))
((stringp symlink-target)
;; It's a symlink, follow it.
(tramp-message
v 5 "Follow symlink to %s" symlink-target)
(setq numchase (1+ numchase))
(when (file-name-absolute-p symlink-target)
(setq result nil))
(setq steps
(append
(split-string symlink-target "/" 'omit)
steps)))
(t
;; It's a file.
(setq result (cons thisstep result)))))
(when (>= numchase numchase-limit)
(tramp-error
v 'file-error
"Maximum number (%d) of symlinks exceeded" numchase-limit))
(setq result (reverse result))
;; Combine list to form string.
(setq result
(if result (string-join (cons "" result) "/") "/"))
(when (string-empty-p result) (setq result "/")))))
;; Detect cycle.
(when (and (file-symlink-p filename)
(string-equal result localname))
(tramp-error
v 'file-error
"Apparent cycle of symbolic links for %s" filename))
;; If the resulting localname looks remote, we must quote it
;; for security reasons.
(when (file-remote-p result)
(setq result (tramp-compat-file-name-quote result 'top)))
(tramp-message v 4 "True name of `%s' is `%s'" localname result)
result))
'nohop)))))
;; Basic functions.
......@@ -2676,7 +2680,7 @@ The method used must be an out-of-band method."
(when (file-symlink-p filename)
(goto-char (search-backward "->" beg 'noerror)))
(search-backward
(if (zerop (length (file-name-nondirectory filename)))
(if (tramp-compat-directory-name-p filename)
"."
(file-name-nondirectory filename))
beg 'noerror)
......
......@@ -986,7 +986,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setq filename (expand-file-name filename))
(unless switches (setq switches ""))
;; Mark trailing "/".
(when (and (zerop (length (file-name-nondirectory filename)))
(when (and (tramp-compat-directory-name-p filename)
(not full-directory-p))
(setq switches (concat switches "F")))
(if full-directory-p
......@@ -1175,8 +1175,7 @@ component is used as the target of the symlink."
;; If TARGET is still remote, quote it.
(if (tramp-tramp-file-p target)
(make-symbolic-link
(let (file-name-handler-alist) (tramp-compat-file-name-quote target))
(make-symbolic-link (tramp-compat-file-name-quote target 'top)
linkname ok-if-already-exists)
;; Do the 'confirm if exists' thing.
......
......@@ -533,34 +533,36 @@ the result will be a local, non-Tramp, file name."
(defun tramp-sudoedit-handle-file-truename (filename)
"Like `file-truename' for Tramp files."
;; Preserve trailing "/".
;; Preserve trailing "/".
(funcall
(if (string-equal (file-name-nondirectory filename) "")
(if (tramp-compat-directory-name-p filename)
#'file-name-as-directory #'identity)
(with-parsed-tramp-file-name (expand-file-name filename) nil
(tramp-make-tramp-file-name
v
(with-tramp-file-property v localname "file-truename"
(let ((quoted (tramp-compat-file-name-quoted-p localname))
(localname (tramp-compat-file-name-unquote localname))
result)
(tramp-message v 4 "Finding true name for `%s'" filename)
(setq result (tramp-sudoedit-send-command-string
v "readlink" "--canonicalize-missing" localname))
;; Detect cycle.
(when (and (file-symlink-p filename)
(string-equal result localname))
(tramp-error
v 'file-error
"Apparent cycle of symbolic links for %s" filename))
;; If the resulting localname looks remote, we must quote it
;; for security reasons.
(when (or quoted (file-remote-p result))
(let (file-name-handler-alist)
(setq result (tramp-compat-file-name-quote result))))
(tramp-message v 4 "True name of `%s' is `%s'" localname result)
result))
'nohop))))
;; Quote properly.
(funcall
(if (tramp-compat-file-name-quoted-p filename)
#'tramp-compat-file-name-quote #'identity)
(with-parsed-tramp-file-name
(tramp-compat-file-name-unquote (expand-file-name filename)) nil
(tramp-make-tramp-file-name
v
(with-tramp-file-property v localname "file-truename"
(let (result)
(tramp-message v 4 "Finding true name for `%s'" filename)
(setq result (tramp-sudoedit-send-command-string
v "readlink" "--canonicalize-missing" localname))
;; Detect cycle.
(when (and (file-symlink-p filename)
(string-equal result localname))
(tramp-error
v 'file-error
"Apparent cycle of symbolic links for %s" filename))
;; If the resulting localname looks remote, we must quote it
;; for security reasons.
(when (file-remote-p result)
(setq result (tramp-compat-file-name-quote result 'top)))
(tramp-message v 4 "True name of `%s' is `%s'" localname result)
result))
'nohop)))))
(defun tramp-sudoedit-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
......@@ -609,8 +611,7 @@ component is used as the target of the symlink."
;; If TARGET is still remote, quote it.
(if (tramp-tramp-file-p target)
(make-symbolic-link
(let (file-name-handler-alist) (tramp-compat-file-name-quote target))
(make-symbolic-link (tramp-compat-file-name-quote target 'top)
linkname ok-if-already-exists)
;; Do the 'confirm if exists' thing.
......
......@@ -2004,13 +2004,11 @@ locally on a remote file name. When the local system is a W32 system
but the remote system is Unix, this introduces a superfluous drive
letter into the file name. This function removes it."
(save-match-data
(funcall
(if (tramp-compat-file-name-quoted-p name)
#'tramp-compat-file-name-quote #'identity)
(let ((name (tramp-compat-file-name-unquote name)))
(if (string-match "\\`[a-zA-Z]:/" name)
(replace-match "/" nil t name)
name)))))
(let ((quoted (tramp-compat-file-name-quoted-p name 'top))
(result (tramp-compat-file-name-unquote name 'top)))
(setq result (if (string-match "\\`[a-zA-Z]:/" result)
(replace-match "/" nil t result) result))
(if quoted (tramp-compat-file-name-quote result 'top) result))))
;;; Config Manipulation Functions:
......@@ -3287,45 +3285,44 @@ User is always nil."
"Like `file-truename' for Tramp files."
;; Preserve trailing "/".
(funcall
(if (string-equal (file-name-nondirectory filename) "")
(if (tramp-compat-directory-name-p filename)
#'file-name-as-directory #'identity)
(let ((result (expand-file-name filename))
(numchase 0)
;; Don't make the following value larger than necessary.
;; People expect an error message in a timely fashion when
;; something is wrong; otherwise they might think that Emacs
;; is hung. Of course, correctness has to come first.
(numchase-limit 20)
symlink-target)
(with-parsed-tramp-file-name result v1
;; We cache only the localname.
(tramp-make-tramp-file-name
v1
(with-tramp-file-property v1 v1-localname "file-truename"
(while (and (setq symlink-target (file-symlink-p result))
(< numchase numchase-limit))
(setq numchase (1+ numchase)
result
(with-parsed-tramp-file-name (expand-file-name result) v2
(tramp-make-tramp-file-name
v2
(funcall
(if (tramp-compat-file-name-quoted-p v2-localname)
#'tramp-compat-file-name-quote #'identity)
;; Quote properly.
(funcall
(if (tramp-compat-file-name-quoted-p filename)
#'tramp-compat-file-name-quote #'identity)
(let ((result (tramp-compat-file-name-unquote (expand-file-name filename)))
(numchase 0)