]> git.eshelyaron.com Git - emacs.git/commitdiff
Fix Tramp IPv6 handling in tests
authorMichael Albinus <michael.albinus@gmx.de>
Mon, 22 Jul 2024 07:56:52 +0000 (09:56 +0200)
committerEshel Yaron <me@eshelyaron.com>
Wed, 24 Jul 2024 16:56:21 +0000 (18:56 +0200)
* 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
lisp/net/tramp-integration.el
lisp/net/tramp-sh.el
lisp/net/tramp.el
test/lisp/net/tramp-tests.el

index 83803fd86135c6aba6979716baf8c931ee206dc3..8d7b6c4f962a85e295e034a7544d6ae09a4d2e70 100644 (file)
@@ -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)))
 
index e1f0b2a3495818ae56ac0d5a8ee1b6b1e82656a4..56deaf9066bf802ff9387f5241e1aaa4bac80852 100644 (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
index 2c2bce75c4ea8ff5902691032c232fef6370846b..de19939071fdf8b075bf3f7f0e9d930793e95815 100644 (file)
@@ -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))
 
index b4577ea3bca80b3ea048b318585d5147d534ee2f..de3de00830016e85fbb1128fe188ecb957b17b49 100644 (file)
@@ -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
index 93e6a3b56c5de4b3be335ffd467e10ee73b43aa9..6ce7132f35d18f581a39a53eed658b36bfc3b95f 100644 (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]#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