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.

diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index b1820b3e2fe0b57844b3d5a528c11b950b1ee1a9..381a5efc77f3b3500de4bb038ef837e4e1dc357e 100644 (file)
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -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)))
 

diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el
index e1f0b2a3495818ae56ac0d5a8ee1b6b1e82656a4..56deaf9066bf802ff9387f5241e1aaa4bac80852 100644 (file)
--- 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 df8ca151718a305e5ee7bfa86f104acf00beecac..8fde854a97b5598d994479622ee90653a4a6730a 100644 (file)
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -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))
 

diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 5c7236011b8f0bdbec8f087e5b99a4f380357b8d..22b3ef846260c9745186fe979956c8e00c9623e8 100644 (file)
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -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

diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 786700c727e13bfe1ee86072e038806311b89b12..e958cd354bcb8b1417bdb02b832fbab393541e3b 100644 (file)
--- 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
@@ -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)