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