From 8f3fde3884d818eb2eef39f8295c5884bc371cc4 Mon Sep 17 00:00:00 2001
From: Michael Albinus <michael.albinus@gmx.de>
Date: Thu, 6 Dec 2018 15:25:22 +0100
Subject: [PATCH] Make stronger tests for Tramp multi hops

* lisp/net/tramp.el (tramp-dissect-file-name, tramp-dissect-hop-name):
Check, that method is capable of multi hops.

* test/lisp/net/tramp-tests.el (tramp-test02-file-name-dissect)
(tramp-test02-file-name-dissect-simplified)
(tramp-test02-file-name-dissect-separate): Suppress check for multihops.
(tramp-test03-file-name-method-rules): Check for error if multi
hops cannot be applied.
---
 lisp/net/tramp.el            | 35 ++++++++++++++++++++++++++---------
 test/lisp/net/tramp-tests.el | 21 ++++++++++++++++++++-
 2 files changed, 46 insertions(+), 10 deletions(-)

diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index fe0ba94f4c7..ab30a43de0d 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1391,19 +1391,36 @@ default values are used."
 		  (and hop
 		       (format-spec hop (format-spec-make ?h host ?u user))))))
 
-	(make-tramp-file-name
-	 :method method :user user :domain domain :host host :port port
-	 :localname localname :hop hop)))))
+	;; Return result.
+	(prog1
+	    (setq v (make-tramp-file-name
+		     :method method :user user :domain domain :host host
+		     :port port :localname localname :hop hop))
+	  ;; Only some methods from tramp-sh.el do support multi-hops.
+	  (when (and
+		 hop
+		 (or (not (tramp-get-method-parameter v 'tramp-login-program))
+		     (tramp-get-method-parameter v 'tramp-copy-program)))
+	    (tramp-user-error
+	     v "Method `%s' is not supported for multi-hops." method)))))))
 
 (defun tramp-dissect-hop-name (name &optional nodefault)
   "Return a `tramp-file-name' structure of `hop' part of NAME.
 See `tramp-dissect-file-name' for details."
-  (tramp-dissect-file-name
-   (concat
-    tramp-prefix-format
-    (replace-regexp-in-string
-     (concat tramp-postfix-hop-regexp "$") tramp-postfix-host-format name))
-   nodefault))
+  (let ((v (tramp-dissect-file-name
+	    (concat tramp-prefix-format
+		    (replace-regexp-in-string
+		     (concat tramp-postfix-hop-regexp "$")
+		     tramp-postfix-host-format name))
+	    nodefault)))
+    ;; Only some methods from tramp-sh.el do support multi-hops.
+    (when (or (not (tramp-get-method-parameter v 'tramp-login-program))
+	      (tramp-get-method-parameter v 'tramp-copy-program))
+      (tramp-user-error
+       v "Method `%s' is not supported for multi-hops."
+       (tramp-file-name-method v)))
+    ;; Return result.
+    v))
 
 (defun tramp-buffer-name (vec)
   "A name for the connection buffer VEC."
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 4016ece94d3..15a120704eb 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -399,7 +399,10 @@ handled properly.  BODY shall not contain a timeout."
 	(tramp-default-host "default-host")
 	tramp-default-method-alist
 	tramp-default-user-alist
-	tramp-default-host-alist)
+	tramp-default-host-alist
+	;; Suppress check for multihops.
+	(tramp-cache-data  (make-hash-table :test 'equal))
+	(tramp-connection-properties '((nil "login-program" t))))
     ;; Expand `tramp-default-user' and `tramp-default-host'.
     (should (string-equal
 	     (file-remote-p "/method::")
@@ -836,6 +839,9 @@ handled properly.  BODY shall not contain a timeout."
 	(tramp-default-host "default-host")
 	tramp-default-user-alist
 	tramp-default-host-alist
+	;; Suppress check for multihops.
+	(tramp-cache-data  (make-hash-table :test 'equal))
+	(tramp-connection-properties '((nil "login-program" t)))
 	(syntax tramp-syntax))
     (unwind-protect
 	(progn
@@ -1157,6 +1163,9 @@ handled properly.  BODY shall not contain a timeout."
 	tramp-default-method-alist
 	tramp-default-user-alist
 	tramp-default-host-alist
+	;; Suppress check for multihops.
+	(tramp-cache-data  (make-hash-table :test 'equal))
+	(tramp-connection-properties '((nil "login-program" t)))
 	(syntax tramp-syntax))
     (unwind-protect
 	(progn
@@ -1851,6 +1860,16 @@ handled properly.  BODY shall not contain a timeout."
 (ert-deftest tramp-test03-file-name-method-rules ()
   "Check file name rules for some methods."
   (skip-unless (tramp--test-enabled))
+  ;; `user-error' has appeared in Emacs 24.3.
+  (skip-unless (fboundp 'user-error))
+
+  ;; Multi hops are allowed for inline methods only.
+  (should-error
+   (file-remote-p "/ssh:user1@host1|method:user2@host2:/path/to/file")
+   :type 'user-error)
+  (should-error
+   (file-remote-p "/method:user1@host1|ssh:user2@host2:/path/to/file")
+   :type 'user-error)
 
   ;; Samba does not support file names with periods followed by
   ;; spaces, and trailing periods or spaces.
-- 
2.39.5