procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix Tramp IPv6 handling in tests

Browse source 
* 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.
This commit is contained in:
Michael Albinus 2024-07-22 09:56:52 +02:00
parent 46b192c04b
commit f050b9c503
5 changed files with 83 additions and 46 deletions
Download patch file Download diff file Expand all files Collapse all files

17
lisp/net/tramp-gvfs.el
View file

@ -2217,8 +2217,8 @@ connection if a previous connection has died for some reason."
(unless (tramp-gvfs-connection-mounted-p vec)
(let ((method (tramp-file-name-method vec))
(user (tramp-file-name-user vec))
(host (tramp-file-name-host vec))
(user-domain (tramp-file-name-user-domain vec))
(host-port (tramp-file-name-host-port vec))
(localname (tramp-file-name-unquote-localname vec))
(object-path
(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."
(with-tramp-progress-reporter
vec 3 (format "Opening connection for %s%s using %s"
(if (tramp-string-empty-or-nil-p user)
"" (concat user "@"))
host method)
(if (tramp-string-empty-or-nil-p user-domain)
"" (concat user-domain "@"))
host-port method)
;; Enable `auth-source'.
(tramp-set-connection-property
@ -2296,13 +2296,14 @@ connection if a previous connection has died for some reason."
(with-timeout
((tramp-get-method-parameter
vec 'tramp-connection-timeout tramp-connection-timeout)
(if (tramp-string-empty-or-nil-p (tramp-file-name-user vec))
(if (tramp-string-empty-or-nil-p user-domain)
(tramp-error
vec 'file-error
"Timeout reached mounting %s using %s" host method)
"Timeout reached mounting %s using %s" host-port method)
(tramp-error
vec 'file-error
"Timeout reached mounting %s@%s using %s" user host method)))
"Timeout reached mounting %s@%s using %s"
user-domain host-port method)))
(while (not (tramp-get-file-property vec "/" "fuse-mountpoint"))
(read-event nil nil 0.1)))

9
lisp/net/tramp-integration.el
View file

@ -275,9 +275,14 @@ NAME must be equal to `tramp-current-connection'."
;;; Integration of shortdoc.el:
(with-eval-after-load 'shortdoc
(dolist (elem '((file-remote-p
(dolist (elem `((file-remote-p
:eval (file-remote-p "/ssh:user@host:/tmp/foo")
:eval (file-remote-p "/ssh:user@host:/tmp/foo" 'method))
:eval (file-remote-p "/ssh:user@host:/tmp/foo" 'method)
:eval (file-remote-p "/ssh:user@[::1]#1234:/tmp/foo" 'host)
;; We don't want to see the text properties.
:no-eval (file-remote-p "/sudo::/tmp/foo" 'user)
:result ,(substring-no-properties
(file-remote-p "/sudo::/tmp/foo" 'user)))
(file-local-name
:eval (file-local-name "/ssh:user@host:/tmp/foo"))
(file-local-copy

4
lisp/net/tramp-sh.el
View file

@ -5289,7 +5289,7 @@ connection if a previous connection has died for some reason."
"" (concat " " process-name))
(if (tramp-string-empty-or-nil-p l-user)
"" (concat l-user "@"))
l-host l-method)
(tramp-file-name-host-port hop) l-method)
(tramp-send-command vec command t t)
(tramp-process-actions
p vec
@ -5317,7 +5317,7 @@ connection if a previous connection has died for some reason."
(if (tramp-string-empty-or-nil-p
(tramp-file-name-user vec))
"" (concat (tramp-file-name-user vec) "@"))
(tramp-file-name-host vec)
(tramp-file-name-host-port vec)
(tramp-file-name-method vec))
(tramp-open-connection-setup-interactive-shell p vec))

17
lisp/net/tramp.el
View file

@ -4290,7 +4290,10 @@ Let-bind it when necessary.")
(file-regular-p (file-truename filename))))))))
(defun tramp-handle-file-remote-p (filename &optional identification connected)
"Like `file-remote-p' for Tramp files."
"Like `file-remote-p' for Tramp files.
It supports the additional IDENTIFICATION `hop'.
For the `host' IDENTIFICATION, both host name and port number (if
existing) are returned."
;; We do not want traces in the debug buffer.
(let ((tramp-verbose (min tramp-verbose 3)))
(when (tramp-tramp-file-p filename)
@ -6793,9 +6796,9 @@ Consults the auth-source package."
proc "password-vector" (process-get proc 'tramp-vector)))
(key (tramp-make-tramp-file-name vec 'noloc))
(method (tramp-file-name-method vec))
(user (or (tramp-file-name-user-domain vec)
(tramp-get-connection-property key "login-as")))
(host (tramp-file-name-host-port vec))
(user-domain (or (tramp-file-name-user-domain vec)
(tramp-get-connection-property key "login-as")))
(host-port (tramp-file-name-host-port vec))
(pw-prompt
(string-trim-left
(or prompt
@ -6823,9 +6826,9 @@ Consults the auth-source package."
(setq auth-info
(car
(auth-source-search
:max 1 :user user :host host :port method
:require (cons :secret (and user '(:user)))
:create (and user t)))
:max 1 :user user-domain :host host-port :port method
:require (cons :secret (and user-domain '(:user)))
:create (and user-domain t)))
tramp-password-save-function
(plist-get auth-info :save-function)
auth-passwd

82
test/lisp/net/tramp-tests.el
View file

@ -848,19 +848,20 @@ is greater than 10.
(should (string-equal (file-remote-p "/method:[::1]:" 'localname) ""))
(should (string-equal (file-remote-p "/method:[::1]:" 'hop) nil))
;; No expansion.
;; No expansion. Hop.
(should (string-equal
(file-remote-p "/method:user@[::1]:")
(format "/%s:%s@%s:" "method" "user" "[::1]")))
(file-remote-p "/method:user@[::1]#1234:")
(format "/%s:%s@%s#%s:" "method" "user" "[::1]" "1234")))
(should (string-equal
(file-remote-p "/method:user@[::1]:" 'method) "method"))
(should
(string-equal (file-remote-p "/method:user@[::1]:" 'user) "user"))
(should
(string-equal (file-remote-p "/method:user@[::1]:" 'host) "::1"))
(file-remote-p "/method:user@[::1]#1234:" 'method) "method"))
(should (string-equal (file-remote-p "/method:user@[::1]#1234:" 'user)
"user"))
(should (string-equal
(file-remote-p "/method:user@[::1]:" 'localname) ""))
(should (string-equal (file-remote-p "/method:user@[::1]:" 'hop) nil))
(file-remote-p "/method:user@[::1]#1234:" 'host) "::1#1234"))
(should (string-equal
(file-remote-p "/method:user@[::1]#1234:" 'localname) ""))
(should (string-equal
(file-remote-p "/method:user@[::1]#1234:" 'hop) nil))
;; Local file name part.
(should (string-equal (file-remote-p "/-:host:/:" 'localname) "/:"))
@ -1244,6 +1245,20 @@ is greater than 10.
(should (string-equal (file-remote-p "/user@[::1]:" 'localname) ""))
(should (string-equal (file-remote-p "/user@[::1]:" 'hop) nil))
;; No expansion. Hop.
(should (string-equal
(file-remote-p "/user@[::1]#1234:")
(format "/%s@%s#%s:" "user" "[::1]" "1234")))
(should (string-equal
(file-remote-p "/user@[::1]#1234:" 'method) "default-method"))
(should
(string-equal (file-remote-p "/user@[::1]#1234:" 'user) "user"))
(should
(string-equal (file-remote-p "/user@[::1]#1234:" 'host) "::1#1234"))
(should
(string-equal (file-remote-p "/user@[::1]#1234:" 'localname) ""))
(should (string-equal (file-remote-p "/user@[::1]#1234:" 'hop) nil))
;; Local file name part.
(should (string-equal (file-remote-p "/host:/:" 'localname) "/:"))
(should (string-equal (file-remote-p "/host::" 'localname) ":"))
@ -1886,19 +1901,20 @@ is greater than 10.
(should (string-equal (file-remote-p "/[method/::1]" 'localname) ""))
(should (string-equal (file-remote-p "/[method/::1]" 'hop) nil))
;; No expansion.
;; No expansion. Hop.
(should (string-equal
(file-remote-p "/[method/user@::1]")
(format "/[%s/%s@%s]" "method" "user" "::1")))
(file-remote-p "/[method/user@::1#1234]")
(format "/[%s/%s@%s#%s]" "method" "user" "::1" "1234")))
(should (string-equal
(file-remote-p "/[method/user@::1]" 'method) "method"))
(file-remote-p "/[method/user@::1#1234]" 'method) "method"))
(should (string-equal
(file-remote-p "/[method/user@::1]" 'user) "user"))
(file-remote-p "/[method/user@::1#1234]" 'user) "user"))
(should (string-equal
(file-remote-p "/[method/user@::1]" 'host) "::1"))
(file-remote-p "/[method/user@::1#1234]" 'host) "::1#1234"))
(should (string-equal
(file-remote-p "/[method/user@::1]" 'localname) ""))
(should (string-equal (file-remote-p "/[method/user@::1]" 'hop) nil))
(file-remote-p "/[method/user@::1#1234]" 'localname) ""))
(should (string-equal
(file-remote-p "/[method/user@::1#1234]" 'hop) nil))
;; Local file name part.
(should (string-equal (file-remote-p "/[/host]/:" 'localname) "/:"))
@ -2425,16 +2441,22 @@ This checks also `file-name-as-directory', `file-name-directory',
;; which ruins the tests.
(let ((tramp-default-method
(file-remote-p ert-remote-temporary-file-directory 'method))
(host (file-remote-p ert-remote-temporary-file-directory 'host)))
(host-port
(file-remote-p ert-remote-temporary-file-directory 'host)))
(dolist
(file
`(,(format "/%s::" tramp-default-method)
,(format
"/-:%s:"
(if (string-match-p tramp-ipv6-regexp host)
(concat
tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
host))))
;; `(file-remote-p ... 'host)' eliminates IPv6
;; delimiters. Add them.
(if (string-match tramp-ipv6-regexp host-port)
(replace-match
(format
"%s\\&%s"
tramp-prefix-ipv6-format tramp-postfix-ipv6-format)
nil nil host-port)
host-port))))
(should (string-equal (directory-file-name file) file))
(should
(string-equal
@ -4796,8 +4818,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(host (file-remote-p ert-remote-temporary-file-directory 'host))
(orig-syntax tramp-syntax)
(minibuffer-completing-file-name t))
(when (and (stringp host) (string-match tramp-host-with-port-regexp host))
(setq host (match-string 1 host)))
(when (and (stringp host)
(string-match
(rx (regexp tramp-prefix-port-regexp) (regexp tramp-port-regexp))
host))
(setq host (replace-match "" nil nil host)))
(unwind-protect
(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'."
(orig-syntax tramp-syntax)
(non-essential t)
(inhibit-message t))
(when (and (stringp host) (string-match tramp-host-with-port-regexp host))
(setq host (match-string 1 host)))
(when (and (stringp host)
(string-match
(rx (regexp tramp-prefix-port-regexp) (regexp tramp-port-regexp))
host))
(setq host (replace-match "" nil nil host)))
;; (trace-function #'tramp-completion-file-name-handler)
;; (trace-function #'completion-file-name-table)