8 files changed, 79 insertions, 38 deletions

diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 31439043435..f0ea073ed09 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -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}.
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index fbf6196ca46..f8edb27c516 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -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
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index 0b8e8da9761..448cfca2ca1 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -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
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 4f564e6eb5c..aa0c99bf9cf 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -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))
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index d0385f3ba28..33af124458d 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -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))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 4cdc39e0b6a..63275448ef8 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -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))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 4497802d770..43b5e77428a 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -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
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index dfb01126f70..5e79a4bce6f 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -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))