Commit 8f3fde38 authored by Michael Albinus's avatar Michael Albinus

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.
parent 8e8b8115
......@@ -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."
......
......@@ -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.
......
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