Skip to content

Commit f050b9c

Browse files
committed
Fix Tramp IPv6 handling in tests
* lisp/net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection): * lisp/net/tramp-sh.el (tramp-maybe-open-connection): Improve message. * lisp/net/tramp-integration.el (shortdoc): Add further examples of `file-remote-p'. * lisp/net/tramp.el (tramp-handle-file-remote-p): Extend docstring. * test/lisp/net/tramp-tests.el (tramp-test02-file-name-dissect) (tramp-test02-file-name-dissect-simplified) (tramp-test02-file-name-dissect-separate): Extend tests. (tramp-test06-directory-file-name) (tramp-test26-file-name-completion) (tramp-test26-interactive-file-name-completion): Better handling of IPv6 hosts.
1 parent 46b192c commit f050b9c

File tree

5 files changed

+83
-46
lines changed

5 files changed

+83
-46
lines changed

lisp/net/tramp-gvfs.el

Lines changed: 9 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -2217,8 +2217,8 @@ connection if a previous connection has died for some reason."
22172217

22182218
(unless (tramp-gvfs-connection-mounted-p vec)
22192219
(let ((method (tramp-file-name-method vec))
2220-
(user (tramp-file-name-user vec))
2221-
(host (tramp-file-name-host vec))
2220+
(user-domain (tramp-file-name-user-domain vec))
2221+
(host-port (tramp-file-name-host-port vec))
22222222
(localname (tramp-file-name-unquote-localname vec))
22232223
(object-path
22242224
(tramp-gvfs-object-path (tramp-make-tramp-file-name vec 'noloc))))
@@ -2246,9 +2246,9 @@ connection if a previous connection has died for some reason."
22462246

22472247
(with-tramp-progress-reporter
22482248
vec 3 (format "Opening connection for %s%s using %s"
2249-
(if (tramp-string-empty-or-nil-p user)
2250-
"" (concat user "@"))
2251-
host method)
2249+
(if (tramp-string-empty-or-nil-p user-domain)
2250+
"" (concat user-domain "@"))
2251+
host-port method)
22522252

22532253
;; Enable `auth-source'.
22542254
(tramp-set-connection-property
@@ -2296,13 +2296,14 @@ connection if a previous connection has died for some reason."
22962296
(with-timeout
22972297
((tramp-get-method-parameter
22982298
vec 'tramp-connection-timeout tramp-connection-timeout)
2299-
(if (tramp-string-empty-or-nil-p (tramp-file-name-user vec))
2299+
(if (tramp-string-empty-or-nil-p user-domain)
23002300
(tramp-error
23012301
vec 'file-error
2302-
"Timeout reached mounting %s using %s" host method)
2302+
"Timeout reached mounting %s using %s" host-port method)
23032303
(tramp-error
23042304
vec 'file-error
2305-
"Timeout reached mounting %s@%s using %s" user host method)))
2305+
"Timeout reached mounting %s@%s using %s"
2306+
user-domain host-port method)))
23062307
(while (not (tramp-get-file-property vec "/" "fuse-mountpoint"))
23072308
(read-event nil nil 0.1)))
23082309

lisp/net/tramp-integration.el

Lines changed: 7 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -275,9 +275,14 @@ NAME must be equal to `tramp-current-connection'."
275275
;;; Integration of shortdoc.el:
276276

277277
(with-eval-after-load 'shortdoc
278-
(dolist (elem '((file-remote-p
278+
(dolist (elem `((file-remote-p
279279
:eval (file-remote-p "/ssh:user@host:/tmp/foo")
280-
:eval (file-remote-p "/ssh:user@host:/tmp/foo" 'method))
280+
:eval (file-remote-p "/ssh:user@host:/tmp/foo" 'method)
281+
:eval (file-remote-p "/ssh:user@[::1]#1234:/tmp/foo" 'host)
282+
;; We don't want to see the text properties.
283+
:no-eval (file-remote-p "/sudo::/tmp/foo" 'user)
284+
:result ,(substring-no-properties
285+
(file-remote-p "/sudo::/tmp/foo" 'user)))
281286
(file-local-name
282287
:eval (file-local-name "/ssh:user@host:/tmp/foo"))
283288
(file-local-copy

lisp/net/tramp-sh.el

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -5289,7 +5289,7 @@ connection if a previous connection has died for some reason."
52895289
"" (concat " " process-name))
52905290
(if (tramp-string-empty-or-nil-p l-user)
52915291
"" (concat l-user "@"))
5292-
l-host l-method)
5292+
(tramp-file-name-host-port hop) l-method)
52935293
(tramp-send-command vec command t t)
52945294
(tramp-process-actions
52955295
p vec
@@ -5317,7 +5317,7 @@ connection if a previous connection has died for some reason."
53175317
(if (tramp-string-empty-or-nil-p
53185318
(tramp-file-name-user vec))
53195319
"" (concat (tramp-file-name-user vec) "@"))
5320-
(tramp-file-name-host vec)
5320+
(tramp-file-name-host-port vec)
53215321
(tramp-file-name-method vec))
53225322
(tramp-open-connection-setup-interactive-shell p vec))
53235323

lisp/net/tramp.el

Lines changed: 10 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -4290,7 +4290,10 @@ Let-bind it when necessary.")
42904290
(file-regular-p (file-truename filename))))))))
42914291

42924292
(defun tramp-handle-file-remote-p (filename &optional identification connected)
4293-
"Like `file-remote-p' for Tramp files."
4293+
"Like `file-remote-p' for Tramp files.
4294+
It supports the additional IDENTIFICATION `hop'.
4295+
For the `host' IDENTIFICATION, both host name and port number (if
4296+
existing) are returned."
42944297
;; We do not want traces in the debug buffer.
42954298
(let ((tramp-verbose (min tramp-verbose 3)))
42964299
(when (tramp-tramp-file-p filename)
@@ -6793,9 +6796,9 @@ Consults the auth-source package."
67936796
proc "password-vector" (process-get proc 'tramp-vector)))
67946797
(key (tramp-make-tramp-file-name vec 'noloc))
67956798
(method (tramp-file-name-method vec))
6796-
(user (or (tramp-file-name-user-domain vec)
6797-
(tramp-get-connection-property key "login-as")))
6798-
(host (tramp-file-name-host-port vec))
6799+
(user-domain (or (tramp-file-name-user-domain vec)
6800+
(tramp-get-connection-property key "login-as")))
6801+
(host-port (tramp-file-name-host-port vec))
67996802
(pw-prompt
68006803
(string-trim-left
68016804
(or prompt
@@ -6823,9 +6826,9 @@ Consults the auth-source package."
68236826
(setq auth-info
68246827
(car
68256828
(auth-source-search
6826-
:max 1 :user user :host host :port method
6827-
:require (cons :secret (and user '(:user)))
6828-
:create (and user t)))
6829+
:max 1 :user user-domain :host host-port :port method
6830+
:require (cons :secret (and user-domain '(:user)))
6831+
:create (and user-domain t)))
68296832
tramp-password-save-function
68306833
(plist-get auth-info :save-function)
68316834
auth-passwd

test/lisp/net/tramp-tests.el

Lines changed: 55 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -848,19 +848,20 @@ is greater than 10.
848848
(should (string-equal (file-remote-p "/method:[::1]:" 'localname) ""))
849849
(should (string-equal (file-remote-p "/method:[::1]:" 'hop) nil))
850850

851-
;; No expansion.
851+
;; No expansion. Hop.
852852
(should (string-equal
853-
(file-remote-p "/method:user@[::1]:")
854-
(format "/%s:%s@%s:" "method" "user" "[::1]")))
853+
(file-remote-p "/method:user@[::1]#1234:")
854+
(format "/%s:%s@%s#%s:" "method" "user" "[::1]" "1234")))
855855
(should (string-equal
856-
(file-remote-p "/method:user@[::1]:" 'method) "method"))
857-
(should
858-
(string-equal (file-remote-p "/method:user@[::1]:" 'user) "user"))
859-
(should
860-
(string-equal (file-remote-p "/method:user@[::1]:" 'host) "::1"))
856+
(file-remote-p "/method:user@[::1]#1234:" 'method) "method"))
857+
(should (string-equal (file-remote-p "/method:user@[::1]#1234:" 'user)
858+
"user"))
859+
(should (string-equal
860+
(file-remote-p "/method:user@[::1]#1234:" 'host) "::1#1234"))
861861
(should (string-equal
862-
(file-remote-p "/method:user@[::1]:" 'localname) ""))
863-
(should (string-equal (file-remote-p "/method:user@[::1]:" 'hop) nil))
862+
(file-remote-p "/method:user@[::1]#1234:" 'localname) ""))
863+
(should (string-equal
864+
(file-remote-p "/method:user@[::1]#1234:" 'hop) nil))
864865

865866
;; Local file name part.
866867
(should (string-equal (file-remote-p "/-:host:/:" 'localname) "/:"))
@@ -1244,6 +1245,20 @@ is greater than 10.
12441245
(should (string-equal (file-remote-p "/user@[::1]:" 'localname) ""))
12451246
(should (string-equal (file-remote-p "/user@[::1]:" 'hop) nil))
12461247

1248+
;; No expansion. Hop.
1249+
(should (string-equal
1250+
(file-remote-p "/user@[::1]#1234:")
1251+
(format "/%s@%s#%s:" "user" "[::1]" "1234")))
1252+
(should (string-equal
1253+
(file-remote-p "/user@[::1]#1234:" 'method) "default-method"))
1254+
(should
1255+
(string-equal (file-remote-p "/user@[::1]#1234:" 'user) "user"))
1256+
(should
1257+
(string-equal (file-remote-p "/user@[::1]#1234:" 'host) "::1#1234"))
1258+
(should
1259+
(string-equal (file-remote-p "/user@[::1]#1234:" 'localname) ""))
1260+
(should (string-equal (file-remote-p "/user@[::1]#1234:" 'hop) nil))
1261+
12471262
;; Local file name part.
12481263
(should (string-equal (file-remote-p "/host:/:" 'localname) "/:"))
12491264
(should (string-equal (file-remote-p "/host::" 'localname) ":"))
@@ -1886,19 +1901,20 @@ is greater than 10.
18861901
(should (string-equal (file-remote-p "/[method/::1]" 'localname) ""))
18871902
(should (string-equal (file-remote-p "/[method/::1]" 'hop) nil))
18881903

1889-
;; No expansion.
1904+
;; No expansion. Hop.
1905+
(should (string-equal
1906+
(file-remote-p "/[method/user@::1#1234]")
1907+
(format "/[%s/%s@%s#%s]" "method" "user" "::1" "1234")))
18901908
(should (string-equal
1891-
(file-remote-p "/[method/user@::1]")
1892-
(format "/[%s/%s@%s]" "method" "user" "::1")))
1909+
(file-remote-p "/[method/user@::1#1234]" 'method) "method"))
18931910
(should (string-equal
1894-
(file-remote-p "/[method/user@::1]" 'method) "method"))
1911+
(file-remote-p "/[method/user@::1#1234]" 'user) "user"))
18951912
(should (string-equal
1896-
(file-remote-p "/[method/user@::1]" 'user) "user"))
1913+
(file-remote-p "/[method/user@::1#1234]" 'host) "::1#1234"))
18971914
(should (string-equal
1898-
(file-remote-p "/[method/user@::1]" 'host) "::1"))
1915+
(file-remote-p "/[method/user@::1#1234]" 'localname) ""))
18991916
(should (string-equal
1900-
(file-remote-p "/[method/user@::1]" 'localname) ""))
1901-
(should (string-equal (file-remote-p "/[method/user@::1]" 'hop) nil))
1917+
(file-remote-p "/[method/user@::1#1234]" 'hop) nil))
19021918

19031919
;; Local file name part.
19041920
(should (string-equal (file-remote-p "/[/host]/:" 'localname) "/:"))
@@ -2425,16 +2441,22 @@ This checks also `file-name-as-directory', `file-name-directory',
24252441
;; which ruins the tests.
24262442
(let ((tramp-default-method
24272443
(file-remote-p ert-remote-temporary-file-directory 'method))
2428-
(host (file-remote-p ert-remote-temporary-file-directory 'host)))
2444+
(host-port
2445+
(file-remote-p ert-remote-temporary-file-directory 'host)))
24292446
(dolist
24302447
(file
24312448
`(,(format "/%s::" tramp-default-method)
24322449
,(format
24332450
"/-:%s:"
2434-
(if (string-match-p tramp-ipv6-regexp host)
2435-
(concat
2436-
tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
2437-
host))))
2451+
;; `(file-remote-p ... 'host)' eliminates IPv6
2452+
;; delimiters. Add them.
2453+
(if (string-match tramp-ipv6-regexp host-port)
2454+
(replace-match
2455+
(format
2456+
"%s\\&%s"
2457+
tramp-prefix-ipv6-format tramp-postfix-ipv6-format)
2458+
nil nil host-port)
2459+
host-port))))
24382460
(should (string-equal (directory-file-name file) file))
24392461
(should
24402462
(string-equal
@@ -4796,8 +4818,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
47964818
(host (file-remote-p ert-remote-temporary-file-directory 'host))
47974819
(orig-syntax tramp-syntax)
47984820
(minibuffer-completing-file-name t))
4799-
(when (and (stringp host) (string-match tramp-host-with-port-regexp host))
4800-
(setq host (match-string 1 host)))
4821+
(when (and (stringp host)
4822+
(string-match
4823+
(rx (regexp tramp-prefix-port-regexp) (regexp tramp-port-regexp))
4824+
host))
4825+
(setq host (replace-match "" nil nil host)))
48014826

48024827
(unwind-protect
48034828
(dolist (syntax (if (tramp--test-expensive-test-p)
@@ -4930,8 +4955,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
49304955
(orig-syntax tramp-syntax)
49314956
(non-essential t)
49324957
(inhibit-message t))
4933-
(when (and (stringp host) (string-match tramp-host-with-port-regexp host))
4934-
(setq host (match-string 1 host)))
4958+
(when (and (stringp host)
4959+
(string-match
4960+
(rx (regexp tramp-prefix-port-regexp) (regexp tramp-port-regexp))
4961+
host))
4962+
(setq host (replace-match "" nil nil host)))
49354963

49364964
;; (trace-function #'tramp-completion-file-name-handler)
49374965
;; (trace-function #'completion-file-name-table)

0 commit comments

Comments
 (0)