From b264543d4e2931666433ad9f69ef3d8e17ca4051 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 22 Jul 2024 09:56:52 +0200 Subject: [PATCH] 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. (cherry picked from commit f050b9c5033ef92ac299d3da30774bc228fd0e08) --- lisp/net/tramp-gvfs.el | 17 ++++----- lisp/net/tramp-integration.el | 9 +++-- lisp/net/tramp-sh.el | 4 +-- lisp/net/tramp.el | 17 +++++---- test/lisp/net/tramp-tests.el | 68 +++++++++++++++++++++++------------ 5 files changed, 73 insertions(+), 42 deletions(-) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 83803fd8613..8d7b6c4f962 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -2216,8 +2216,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)))) @@ -2245,9 +2245,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 @@ -2295,13 +2295,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))) diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el index e1f0b2a3495..56deaf9066b 100644 --- a/lisp/net/tramp-integration.el +++ b/lisp/net/tramp-integration.el @@ -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 diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 2c2bce75c4e..de19939071f 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -5298,7 +5298,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 @@ -5326,7 +5326,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)) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index b4577ea3bca..de3de008300 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4280,7 +4280,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) @@ -6782,9 +6785,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 @@ -6812,9 +6815,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 diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 93e6a3b56c5..6ce7132f35d 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -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]#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) "/:")) @@ -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#1234]") + (format "/[%s/%s@%s#%s]" "method" "user" "::1" "1234"))) (should (string-equal - (file-remote-p "/[method/user@::1]") - (format "/[%s/%s@%s]" "method" "user" "::1"))) + (file-remote-p "/[method/user@::1#1234]" 'method) "method")) (should (string-equal - (file-remote-p "/[method/user@::1]" 'method) "method")) + (file-remote-p "/[method/user@::1#1234]" 'user) "user")) (should (string-equal - (file-remote-p "/[method/user@::1]" 'user) "user")) + (file-remote-p "/[method/user@::1#1234]" 'host) "::1#1234")) (should (string-equal - (file-remote-p "/[method/user@::1]" 'host) "::1")) + (file-remote-p "/[method/user@::1#1234]" 'localname) "")) (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]" '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 -- 2.39.2