Commit b9340aad authored by Michael Albinus's avatar Michael Albinus
Browse files

Fix Bug#30946

* doc/misc/tramp.texi (Multi-hops): Mention host name checks.

* lisp/net/tramp.el (tramp-set-syntax, tramp-dissect-file-name)
(tramp-debug-message, tramp-handle-shell-command):
* lisp/net/tramp-adb.el (tramp-adb-handle-shell-command):
* lisp/net/tramp-archive.el (tramp-archive-file-name-handler)
(tramp-archive-dissect-file-name):
* lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler): Adapt callees.

* lisp/net/tramp-compat.el (tramp-compat-user-error): Move defsubst ---

* lisp/net/tramp-sh.el (tramp-compute-multi-hops): Check for proper
host names in multi-hop.  (Bug#30946)

* lisp/net/tramp.el (tramp-user-error): ... here.  Make it a defun.

* test/lisp/net/tramp-tests.el (tramp-test03-file-name-host-rules):
New test.
parent 9ad3560d
......@@ -1408,8 +1408,10 @@ Opening @file{@trampfn{sudo,randomhost.your.domain,}} first connects
to @samp{randomhost.your.domain} via @code{ssh} under your account
name, and then performs @code{sudo -u root} on that host.
It is key for the sudo method in the above example to be applied on
the host after reaching it and not on the local host.
It is key for the @option{sudo} method in the above example to be
applied on the host after reaching it and not on the local host.
@value{tramp} checks therefore, that the host name for such hops
matches the host name of the previous hop.
@var{host}, @var{user} and @var{proxy} can also take Lisp forms. These
forms when evaluated must return either a string or @code{nil}.
......
......@@ -999,7 +999,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(when p
(if (yes-or-no-p "A command is running. Kill it? ")
(ignore-errors (kill-process p))
(tramp-compat-user-error p "Shell command in progress")))
(tramp-user-error p "Shell command in progress")))
(if current-buffer-p
(progn
......
......@@ -311,7 +311,7 @@ pass to the OPERATION."
(tramp-archive-run-real-handler operation args)
;; Now run the handler.
(unless tramp-archive-enabled
(tramp-compat-user-error nil "Package `tramp-archive' not supported"))
(tramp-user-error nil "Package `tramp-archive' not supported"))
(let ((tramp-methods (cons `(,tramp-archive-method) tramp-methods))
(tramp-gvfs-methods tramp-archive-all-gvfs-methods)
;; Set uid and gid. gvfsd-archive could do it, but it doesn't.
......@@ -398,7 +398,7 @@ hexified archive name as host, and the localname. The archive
name is kept in slot `hop'"
(save-match-data
(unless (tramp-archive-file-name-p name)
(tramp-compat-user-error nil "Not an archive file name: \"%s\"" name))
(tramp-user-error nil "Not an archive file name: \"%s\"" name))
(let* ((localname (tramp-archive-file-name-localname name))
(archive (file-truename (tramp-archive-file-name-archive name)))
(vec (make-tramp-file-name
......
......@@ -97,13 +97,6 @@ Add the extension of F, if existing."
process-name))))
(setq result t)))))))))
;; `user-error' has appeared in Emacs 24.3.
(defsubst tramp-compat-user-error (vec-or-proc format &rest args)
"Signal a pilot error."
(apply
'tramp-error vec-or-proc
(if (fboundp 'user-error) 'user-error 'error) format args))
;; `default-toplevel-value' has been declared in Emacs 24.4.
(unless (fboundp 'default-toplevel-value)
(defalias 'default-toplevel-value 'symbol-value))
......
......@@ -751,7 +751,7 @@ Operations not mentioned here will be handled by the default Emacs primitives.")
First arg specifies the OPERATION, second arg is a list of arguments to
pass to the OPERATION."
(unless tramp-gvfs-enabled
(tramp-compat-user-error nil "Package `tramp-gvfs' not supported"))
(tramp-user-error nil "Package `tramp-gvfs' not supported"))
(let ((fn (assoc operation tramp-gvfs-file-name-handler-alist)))
(if fn
(save-match-data (apply (cdr fn) args))
......
......@@ -327,7 +327,6 @@ The string is used in `tramp-methods'.")
(add-to-list 'tramp-methods
`("plink"
(tramp-login-program "plink")
;; ("%h") must be a single element, see `tramp-compute-multi-hops'.
(tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("-t")
("%h") ("\"")
(,(format
......@@ -4636,25 +4635,24 @@ Goes through the list `tramp-inline-compress-commands'."
"Method `%s' is not supported for multi-hops."
(tramp-file-name-method item)))))
;; In case the host name is not used for the remote shell
;; command, the user could be misguided by applying a random
;; host name.
(let* ((v (car target-alist))
(method (tramp-file-name-method v))
(host (tramp-file-name-host v)))
(unless
(or
;; There are multi-hops.
(cdr target-alist)
;; The host name is used for the remote shell command.
(member '("%h") (tramp-get-method-parameter v 'tramp-login-args))
;; The host is local. We cannot use `tramp-local-host-p'
;; here, because it opens a connection as well.
(string-match tramp-local-host-regexp host))
(tramp-error
v 'file-error
"Host `%s' looks like a remote host, `%s' can only use the local host"
host method)))
;; Some methods ("su", "sg", "sudo", "doas", "ksu") do not use the
;; host name in their command template. In this case, the remote
;; file name must use either a local host name (first hop), or a
;; host name matching the previous hop.
(let ((previous-host tramp-local-host-regexp))
(setq choices target-alist)
(while (setq item (pop choices))
(let ((host (tramp-file-name-host item)))
(unless
(or
;; The host name is used for the remote shell command.
(member
'("%h") (tramp-get-method-parameter item 'tramp-login-args))
;; The host name must match previous hop.
(string-match previous-host host))
(tramp-user-error
item "Host name `%s' does not match `%s'" host previous-host))
(setq previous-host (concat "^" (regexp-quote host) "$")))))
;; Result.
target-alist))
......
......@@ -689,7 +689,7 @@ Used in user option `tramp-syntax'. There are further variables
to be set, depending on VALUE."
;; Check allowed values.
(unless (memq value (tramp-syntax-values))
(tramp-compat-user-error "Wrong `tramp-syntax' %s" tramp-syntax))
(tramp-user-error "Wrong `tramp-syntax' %s" tramp-syntax))
;; Cleanup existing buffers.
(unless (eq (symbol-value symbol) value)
(tramp-cleanup-all-buffers))
......@@ -1348,7 +1348,7 @@ to their default values. For the other file name parts, no
default values are used."
(save-match-data
(unless (tramp-tramp-file-p name)
(tramp-compat-user-error nil "Not a Tramp file name: \"%s\"" name))
(tramp-user-error nil "Not a Tramp file name: \"%s\"" name))
(if (not (string-match (nth 0 tramp-file-name-structure) name))
(error "`tramp-file-name-structure' didn't match!")
(let ((method (match-string (nth 1 tramp-file-name-structure) name))
......@@ -1608,12 +1608,12 @@ ARGUMENTS to actually emit the message (if applicable)."
(regexp-opt
'("tramp-backtrace"
"tramp-compat-funcall"
"tramp-compat-user-error"
"tramp-condition-case-unless-debug"
"tramp-debug-message"
"tramp-error"
"tramp-error-with-buffer"
"tramp-message")
"tramp-message"
"tramp-user-error")
t)
"$")
fn)))
......@@ -1753,6 +1753,31 @@ an input event arrives. The other arguments are passed to `tramp-error'."
(when (tramp-file-name-equal-p vec (car tramp-current-connection))
(setcdr tramp-current-connection (current-time)))))))
;; We must make it a defun, because it is used earlier already.
(defun tramp-user-error (vec-or-proc fmt-string &rest arguments)
"Signal a pilot error."
(unwind-protect
(apply
'tramp-error vec-or-proc
;; `user-error' has appeared in Emacs 24.3.
(if (fboundp 'user-error) 'user-error 'error) fmt-string arguments)
;; Save exit.
(when (and tramp-message-show-message
(not (zerop tramp-verbose))
;; Do not show when flagged from outside.
(not (tramp-completion-mode-p))
;; Show only when Emacs has started already.
(current-message))
(let ((enable-recursive-minibuffers t))
;; `tramp-error' does not show messages. So we must do it ourselves.
(apply 'message fmt-string arguments)
(discard-input)
(sit-for 30)
;; Reset timestamp. It would be wrong after waiting for a while.
(when
(tramp-file-name-equal-p vec-or-proc (car tramp-current-connection))
(setcdr tramp-current-connection (current-time)))))))
(defmacro tramp-with-demoted-errors (vec-or-proc format &rest body)
"Execute BODY while redirecting the error message to `tramp-message'.
BODY is executed like wrapped by `with-demoted-errors'. FORMAT
......@@ -3503,7 +3528,7 @@ support symbolic links."
(when p
(if (yes-or-no-p "A command is running. Kill it? ")
(ignore-errors (kill-process p))
(tramp-compat-user-error p "Shell command in progress")))
(tramp-user-error p "Shell command in progress")))
(if current-buffer-p
(progn
......
......@@ -1722,6 +1722,28 @@ handled properly. BODY shall not contain a timeout."
;; Default values in tramp-smb.el.
(should (string-equal (file-remote-p "/smb::" 'user) nil)))
;; The following test is inspired by Bug#30946.
(ert-deftest tramp-test03-file-name-host-rules ()
"Check host name rules for host-less methods."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
;; Host names must match rules in case the command template of a
;; method doesn't use them.
(dolist (m '("su" "sg" "sudo" "doas" "ksu"))
;; Single hop. The host name must match `tramp-local-host-regexp'.
(should-error
(find-file (format "/%s:foo:" m))
:type 'user-error)
;; Multi hop. The host name must match the previous hop.
(should-error
(find-file
(format
"%s|%s:foo:"
(substring (file-remote-p tramp-test-temporary-file-directory) nil -1)
m))
:type 'user-error)))
(ert-deftest tramp-test04-substitute-in-file-name ()
"Check `substitute-in-file-name'."
(should (string-equal (substitute-in-file-name "/method:host:///foo") "/foo"))
......@@ -1836,6 +1858,7 @@ handled properly. BODY shall not contain a timeout."
;; Mark as failed until bug has been fixed.
:expected-result :failed
(skip-unless (tramp--test-enabled))
;; These are the methods the test doesn't fail.
(when (or (tramp--test-adb-p) (tramp--test-gvfs-p)
(tramp-smb-file-name-p tramp-test-temporary-file-directory))
......
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