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.

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}.

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

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

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))

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))

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))

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

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))