Commit 7aaf5007 authored by Michael Albinus's avatar Michael Albinus

Stronger check for Tramp method

* lisp/net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection):
* lisp/net/tramp-rclone.el (tramp-rclone-maybe-open-connection):
* lisp/net/tramp-sudoedit.el (tramp-sudoedit-maybe-open-connection):
Use `tramp-get-connection-name'.

* lisp/net/tramp-sh.el (tramp-sh-handle-make-symbolic-link):
* lisp/net/tramp-smb.el (tramp-smb-handle-make-symbolic-link):
* lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-make-symbolic-link):
Don't check remote TARGET.

* lisp/net/tramp.el (tramp-dissect-file-name): Check for proper method.
(tramp-file-name-for-operation): Take only 2nd argument into
account for file name handler.
(tramp-file-name-handler): Suppress checks for `file-remote-p'.

* test/lisp/net/tramp-archive-tests.el
(tramp-archive-test02-file-name-dissect): Suppress check for wrong
method.

* test/lisp/net/tramp-tests.el (tramp--test-instrument-test-case):
Dump *all* Tramp buffers.
(tramp-test02-file-name-dissect)
(tramp-test02-file-name-dissect-simplified)
(tramp-test02-file-name-dissect-separate): Check also wrong method.
(tramp-test03-file-name-defaults): Check, that the respective
Tramp package is loaded.
(tramp-test04-substitute-in-file-name)
(tramp-test05-expand-file-name)
(tramp-test06-directory-file-name, tramp-test44-auto-load):
Suppress check for wrong method.
(tramp-test30-make-process): Remove instrumentation code.
(tramp-test31-interrupt-process, tramp-test36-vc-registered):
Guarantee that connection is established prior starting process.
parent 512f0364
Pipeline #1890 failed with stage
in 4 seconds
...@@ -1765,7 +1765,7 @@ connection if a previous connection has died for some reason." ...@@ -1765,7 +1765,7 @@ connection if a previous connection has died for some reason."
;; better solution? ;; better solution?
(unless (get-buffer-process (tramp-get-connection-buffer vec)) (unless (get-buffer-process (tramp-get-connection-buffer vec))
(let ((p (make-network-process (let ((p (make-network-process
:name (tramp-buffer-name vec) :name (tramp-get-connection-name vec)
:buffer (tramp-get-connection-buffer vec) :buffer (tramp-get-connection-buffer vec)
:server t :host 'local :service t :noquery t))) :server t :host 'local :service t :noquery t)))
(process-put p 'vector vec) (process-put p 'vector vec)
......
...@@ -543,7 +543,7 @@ connection if a previous connection has died for some reason." ...@@ -543,7 +543,7 @@ connection if a previous connection has died for some reason."
;; we create a dummy process. Maybe there is a better solution? ;; we create a dummy process. Maybe there is a better solution?
(unless (get-buffer-process (tramp-get-connection-buffer vec)) (unless (get-buffer-process (tramp-get-connection-buffer vec))
(let ((p (make-network-process (let ((p (make-network-process
:name (tramp-buffer-name vec) :name (tramp-get-connection-name vec)
:buffer (tramp-get-connection-buffer vec) :buffer (tramp-get-connection-buffer vec)
:server t :host 'local :service t :noquery t))) :server t :host 'local :service t :noquery t)))
(process-put p 'vector vec) (process-put p 'vector vec)
......
...@@ -1027,11 +1027,13 @@ component is used as the target of the symlink." ...@@ -1027,11 +1027,13 @@ component is used as the target of the symlink."
(with-parsed-tramp-file-name linkname nil (with-parsed-tramp-file-name linkname nil
;; If TARGET is a Tramp name, use just the localname component. ;; If TARGET is a Tramp name, use just the localname component.
;; Don't check for a proper method.
(let ((non-essential t))
(when (and (tramp-tramp-file-p target) (when (and (tramp-tramp-file-p target)
(tramp-file-name-equal-p v (tramp-dissect-file-name target))) (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
(setq target (setq target
(tramp-file-name-localname (tramp-file-name-localname
(tramp-dissect-file-name (expand-file-name target))))) (tramp-dissect-file-name (expand-file-name target))))))
;; If TARGET is still remote, quote it. ;; If TARGET is still remote, quote it.
(if (tramp-tramp-file-p target) (if (tramp-tramp-file-p target)
......
...@@ -1161,11 +1161,13 @@ component is used as the target of the symlink." ...@@ -1161,11 +1161,13 @@ component is used as the target of the symlink."
(with-parsed-tramp-file-name linkname nil (with-parsed-tramp-file-name linkname nil
;; If TARGET is a Tramp name, use just the localname component. ;; If TARGET is a Tramp name, use just the localname component.
;; Don't check for a proper method.
(let ((non-essential t))
(when (and (tramp-tramp-file-p target) (when (and (tramp-tramp-file-p target)
(tramp-file-name-equal-p v (tramp-dissect-file-name target))) (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
(setq target (setq target
(tramp-file-name-localname (tramp-file-name-localname
(tramp-dissect-file-name (expand-file-name target))))) (tramp-dissect-file-name (expand-file-name target))))))
;; If TARGET is still remote, quote it. ;; If TARGET is still remote, quote it.
(if (tramp-tramp-file-p target) (if (tramp-tramp-file-p target)
......
...@@ -607,11 +607,13 @@ component is used as the target of the symlink." ...@@ -607,11 +607,13 @@ component is used as the target of the symlink."
(with-parsed-tramp-file-name linkname nil (with-parsed-tramp-file-name linkname nil
;; If TARGET is a Tramp name, use just the localname component. ;; If TARGET is a Tramp name, use just the localname component.
;; Don't check for a proper method.
(let ((non-essential t))
(when (and (tramp-tramp-file-p target) (when (and (tramp-tramp-file-p target)
(tramp-file-name-equal-p v (tramp-dissect-file-name target))) (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
(setq target (setq target
(tramp-file-name-localname (tramp-file-name-localname
(tramp-dissect-file-name (expand-file-name target))))) (tramp-dissect-file-name (expand-file-name target))))))
;; If TARGET is still remote, quote it. ;; If TARGET is still remote, quote it.
(if (tramp-tramp-file-p target) (if (tramp-tramp-file-p target)
...@@ -780,7 +782,7 @@ connection if a previous connection has died for some reason." ...@@ -780,7 +782,7 @@ connection if a previous connection has died for some reason."
(throw 'non-essential 'non-essential)) (throw 'non-essential 'non-essential))
(let ((p (make-network-process (let ((p (make-network-process
:name (tramp-buffer-name vec) :name (tramp-get-connection-name vec)
:buffer (tramp-get-connection-buffer vec) :buffer (tramp-get-connection-buffer vec)
:server t :host 'local :service t :noquery t))) :server t :host 'local :service t :noquery t)))
(process-put p 'vector vec) (process-put p 'vector vec)
......
...@@ -1435,6 +1435,12 @@ default values are used." ...@@ -1435,6 +1435,12 @@ default values are used."
(setq v (make-tramp-file-name (setq v (make-tramp-file-name
:method method :user user :domain domain :host host :method method :user user :domain domain :host host
:port port :localname localname :hop hop)) :port port :localname localname :hop hop))
;; The method must be known.
(unless (or (tramp-completion-mode-p)
(string-equal method tramp-default-method-marker)
(assoc method tramp-methods))
(tramp-user-error
v "Method `%s' is not known." method))
;; Only some methods from tramp-sh.el do support multi-hops. ;; Only some methods from tramp-sh.el do support multi-hops.
(when (and (when (and
hop hop
...@@ -2175,17 +2181,16 @@ Must be handled by the callers." ...@@ -2175,17 +2181,16 @@ Must be handled by the callers."
(if (file-name-absolute-p (nth 0 args)) (if (file-name-absolute-p (nth 0 args))
(nth 0 args) (nth 0 args)
default-directory)) default-directory))
;; STRING FILE.
;; Starting with Emacs 26.1, just the 2nd argument of
;; `make-symbolic-link' matters.
((eq operation 'make-symbolic-link) (nth 1 args))
;; FILE DIRECTORY resp FILE1 FILE2. ;; FILE DIRECTORY resp FILE1 FILE2.
((member operation ((member operation
'(add-name-to-file copy-directory copy-file '(add-name-to-file copy-directory copy-file
file-equal-p file-in-directory-p file-equal-p file-in-directory-p
file-name-all-completions file-name-completion file-name-all-completions file-name-completion
;; Starting with Emacs 26.1, just the 2nd argument of file-newer-than-file-p rename-file))
;; `make-symbolic-link' matters. For backward
;; compatibility, we still accept the first argument as
;; file name to be checked. Handled properly in
;; `tramp-handle-*-make-symbolic-link'.
file-newer-than-file-p make-symbolic-link rename-file))
(cond (cond
((tramp-tramp-file-p (nth 0 args)) (nth 0 args)) ((tramp-tramp-file-p (nth 0 args)) (nth 0 args))
((tramp-tramp-file-p (nth 1 args)) (nth 1 args)) ((tramp-tramp-file-p (nth 1 args)) (nth 1 args))
...@@ -2280,7 +2285,10 @@ preventing reentrant calls of Tramp.") ...@@ -2280,7 +2285,10 @@ preventing reentrant calls of Tramp.")
(defun tramp-file-name-handler (operation &rest args) (defun tramp-file-name-handler (operation &rest args)
"Invoke Tramp file name handler. "Invoke Tramp file name handler.
Falls back to normal file name handler if no Tramp file name handler exists." Falls back to normal file name handler if no Tramp file name handler exists."
(let ((filename (apply #'tramp-file-name-for-operation operation args))) (let ((filename (apply #'tramp-file-name-for-operation operation args))
;; `file-remote-p' is called for everything, even for symbolic
;; links which look remote. We don't want to get an error.
(non-essential (or non-essential (eq operation 'file-remote-p))))
(if (tramp-tramp-file-p filename) (if (tramp-tramp-file-p filename)
(save-match-data (save-match-data
(setq filename (tramp-replace-environment-variables filename)) (setq filename (tramp-replace-environment-variables filename))
......
...@@ -157,6 +157,8 @@ variables, so we check the Emacs version directly." ...@@ -157,6 +157,8 @@ variables, so we check the Emacs version directly."
"Check archive file name components." "Check archive file name components."
(skip-unless tramp-archive-enabled) (skip-unless tramp-archive-enabled)
;; Suppress method name check.
(let ((non-essential t))
(with-parsed-tramp-archive-file-name tramp-archive-test-archive nil (with-parsed-tramp-archive-file-name tramp-archive-test-archive nil
(should (string-equal method tramp-archive-method)) (should (string-equal method tramp-archive-method))
(should-not user) (should-not user)
...@@ -210,9 +212,10 @@ variables, so we check the Emacs version directly." ...@@ -210,9 +212,10 @@ variables, so we check the Emacs version directly."
(string-equal (string-equal
host host
(file-remote-p (file-remote-p
(tramp-archive-gvfs-file-name tramp-archive-test-archive) 'host))) (tramp-archive-gvfs-file-name tramp-archive-test-archive)
;; We reimplement the logic of tramp-archive.el here. Don't 'host)))
;; know, whether it is worth the test. ;; We reimplement the logic of tramp-archive.el here.
;; Don't know, whether it is worth the test.
(should (should
(string-equal (string-equal
host host
...@@ -227,11 +230,12 @@ variables, so we check the Emacs version directly." ...@@ -227,11 +230,12 @@ variables, so we check the Emacs version directly."
(url-hexify-string (url-hexify-string
(concat (concat
"file://" "file://"
;; `directory-file-name' does not leave file archive ;; `directory-file-name' does not leave file
;; boundaries. So we must cut the trailing slash ;; archive boundaries. So we must cut the
;; ourselves. ;; trailing slash ourselves.
(substring (substring
(file-name-directory tramp-archive-test-file-archive) 0 -1))) (file-name-directory tramp-archive-test-file-archive)
0 -1)))
nil "/")) nil "/"))
(file-name-nondirectory tramp-archive-test-file-archive))))) (file-name-nondirectory tramp-archive-test-file-archive)))))
(should-not port) (should-not port)
...@@ -239,7 +243,7 @@ variables, so we check the Emacs version directly." ...@@ -239,7 +243,7 @@ variables, so we check the Emacs version directly."
(should (string-equal archive tramp-archive-test-file-archive))) (should (string-equal archive tramp-archive-test-file-archive)))
;; Cleanup. ;; Cleanup.
(tramp-archive-cleanup-hash)))) (tramp-archive-cleanup-hash)))))
(ert-deftest tramp-archive-test05-expand-file-name () (ert-deftest tramp-archive-test05-expand-file-name ()
"Check `expand-file-name'." "Check `expand-file-name'."
......
...@@ -176,10 +176,9 @@ properly. BODY shall not contain a timeout." ...@@ -176,10 +176,9 @@ properly. BODY shall not contain a timeout."
(let ((tramp--test-instrument-test-case-p t)) ,@body) (let ((tramp--test-instrument-test-case-p t)) ,@body)
;; Unwind forms. ;; Unwind forms.
(when (and (null tramp--test-instrument-test-case-p) (> tramp-verbose 3)) (when (and (null tramp--test-instrument-test-case-p) (> tramp-verbose 3))
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil (dolist (buf (tramp-list-tramp-buffers))
(with-current-buffer (tramp-get-connection-buffer v) (message ";; %s" buf)
(message "%s" (buffer-string))) (with-current-buffer buf
(with-current-buffer (tramp-get-debug-buffer v)
(message "%s" (buffer-string)))))))) (message "%s" (buffer-string))))))))
(defsubst tramp--test-message (fmt-string &rest arguments) (defsubst tramp--test-message (fmt-string &rest arguments)
...@@ -412,15 +411,26 @@ properly. BODY shall not contain a timeout." ...@@ -412,15 +411,26 @@ properly. BODY shall not contain a timeout."
(ert-deftest tramp-test02-file-name-dissect () (ert-deftest tramp-test02-file-name-dissect ()
"Check remote file name components." "Check remote file name components."
;; `user-error' has appeared in Emacs 24.3.
(skip-unless (fboundp 'user-error))
(let ((tramp-default-method "default-method") (let ((tramp-default-method "default-method")
(tramp-default-user "default-user") (tramp-default-user "default-user")
(tramp-default-host "default-host") (tramp-default-host "default-host")
tramp-default-method-alist tramp-default-method-alist
tramp-default-user-alist tramp-default-user-alist
tramp-default-host-alist tramp-default-host-alist
;; Suppress method name check.
(non-essential t)
;; Suppress check for multihops. ;; Suppress check for multihops.
(tramp-cache-data (make-hash-table :test #'equal)) (tramp-cache-data (make-hash-table :test #'equal))
(tramp-connection-properties '((nil "login-program" t)))) (tramp-connection-properties '((nil "login-program" t))))
;; An unknown method shall raise an error.
(let (non-essential)
(should-error
(expand-file-name "/method:user@host:")
:type 'user-error))
;; Expand `tramp-default-user' and `tramp-default-host'. ;; Expand `tramp-default-user' and `tramp-default-host'.
(should (string-equal (should (string-equal
(file-remote-p "/method::") (file-remote-p "/method::")
...@@ -527,7 +537,8 @@ properly. BODY shall not contain a timeout." ...@@ -527,7 +537,8 @@ properly. BODY shall not contain a timeout."
(should (string-equal (should (string-equal
(file-remote-p "/-:user@host#1234:" 'method) "default-method")) (file-remote-p "/-:user@host#1234:" 'method) "default-method"))
(should (string-equal (file-remote-p "/-:user@host#1234:" 'user) "user")) (should (string-equal (file-remote-p "/-:user@host#1234:" 'user) "user"))
(should (string-equal (file-remote-p "/-:user@host#1234:" 'host) "host#1234")) (should (string-equal
(file-remote-p "/-:user@host#1234:" 'host) "host#1234"))
(should (string-equal (file-remote-p "/-:user@host#1234:" 'localname) "")) (should (string-equal (file-remote-p "/-:user@host#1234:" 'localname) ""))
(should (string-equal (file-remote-p "/-:user@host#1234:" 'hop) nil)) (should (string-equal (file-remote-p "/-:user@host#1234:" 'hop) nil))
...@@ -563,7 +574,8 @@ properly. BODY shall not contain a timeout." ...@@ -563,7 +574,8 @@ properly. BODY shall not contain a timeout."
(should (string-equal (should (string-equal
(file-remote-p "/-:1.2.3.4:") (file-remote-p "/-:1.2.3.4:")
(format "/%s:%s@%s:" "default-method" "default-user" "1.2.3.4"))) (format "/%s:%s@%s:" "default-method" "default-user" "1.2.3.4")))
(should (string-equal (file-remote-p "/-:1.2.3.4:" 'method) "default-method")) (should (string-equal
(file-remote-p "/-:1.2.3.4:" 'method) "default-method"))
(should (string-equal (file-remote-p "/-:1.2.3.4:" 'user) "default-user")) (should (string-equal (file-remote-p "/-:1.2.3.4:" 'user) "default-user"))
(should (string-equal (file-remote-p "/-:1.2.3.4:" 'host) "1.2.3.4")) (should (string-equal (file-remote-p "/-:1.2.3.4:" 'host) "1.2.3.4"))
(should (string-equal (file-remote-p "/-:1.2.3.4:" 'localname) "")) (should (string-equal (file-remote-p "/-:1.2.3.4:" 'localname) ""))
...@@ -852,11 +864,16 @@ properly. BODY shall not contain a timeout." ...@@ -852,11 +864,16 @@ properly. BODY shall not contain a timeout."
(ert-deftest tramp-test02-file-name-dissect-simplified () (ert-deftest tramp-test02-file-name-dissect-simplified ()
"Check simplified file name components." "Check simplified file name components."
:tags '(:expensive-test) :tags '(:expensive-test)
;; `user-error' has appeared in Emacs 24.3.
(skip-unless (fboundp 'user-error))
(let ((tramp-default-method "default-method") (let ((tramp-default-method "default-method")
(tramp-default-user "default-user") (tramp-default-user "default-user")
(tramp-default-host "default-host") (tramp-default-host "default-host")
tramp-default-user-alist tramp-default-user-alist
tramp-default-host-alist tramp-default-host-alist
;; Suppress method name check.
(non-essential t)
;; Suppress check for multihops. ;; Suppress check for multihops.
(tramp-cache-data (make-hash-table :test #'equal)) (tramp-cache-data (make-hash-table :test #'equal))
(tramp-connection-properties '((nil "login-program" t))) (tramp-connection-properties '((nil "login-program" t)))
...@@ -864,6 +881,12 @@ properly. BODY shall not contain a timeout." ...@@ -864,6 +881,12 @@ properly. BODY shall not contain a timeout."
(unwind-protect (unwind-protect
(progn (progn
(tramp-change-syntax 'simplified) (tramp-change-syntax 'simplified)
;; An unknown default method shall raise an error.
(let (non-essential)
(should-error
(expand-file-name "/user@host:")
:type 'user-error))
;; Expand `tramp-default-method' and `tramp-default-user'. ;; Expand `tramp-default-method' and `tramp-default-user'.
(should (string-equal (should (string-equal
(file-remote-p "/host:") (file-remote-p "/host:")
...@@ -1175,12 +1198,17 @@ properly. BODY shall not contain a timeout." ...@@ -1175,12 +1198,17 @@ properly. BODY shall not contain a timeout."
(ert-deftest tramp-test02-file-name-dissect-separate () (ert-deftest tramp-test02-file-name-dissect-separate ()
"Check separate file name components." "Check separate file name components."
:tags '(:expensive-test) :tags '(:expensive-test)
;; `user-error' has appeared in Emacs 24.3.
(skip-unless (fboundp 'user-error))
(let ((tramp-default-method "default-method") (let ((tramp-default-method "default-method")
(tramp-default-user "default-user") (tramp-default-user "default-user")
(tramp-default-host "default-host") (tramp-default-host "default-host")
tramp-default-method-alist tramp-default-method-alist
tramp-default-user-alist tramp-default-user-alist
tramp-default-host-alist tramp-default-host-alist
;; Suppress method name check.
(non-essential t)
;; Suppress check for multihops. ;; Suppress check for multihops.
(tramp-cache-data (make-hash-table :test #'equal)) (tramp-cache-data (make-hash-table :test #'equal))
(tramp-connection-properties '((nil "login-program" t))) (tramp-connection-properties '((nil "login-program" t)))
...@@ -1188,6 +1216,12 @@ properly. BODY shall not contain a timeout." ...@@ -1188,6 +1216,12 @@ properly. BODY shall not contain a timeout."
(unwind-protect (unwind-protect
(progn (progn
(tramp-change-syntax 'separate) (tramp-change-syntax 'separate)
;; An unknown method shall raise an error.
(let (non-essential)
(should-error
(expand-file-name "/[method/user@host]")
:type 'user-error))
;; Expand `tramp-default-user' and `tramp-default-host'. ;; Expand `tramp-default-user' and `tramp-default-host'.
(should (string-equal (should (string-equal
(file-remote-p "/[method/]") (file-remote-p "/[method/]")
...@@ -1826,12 +1860,16 @@ properly. BODY shall not contain a timeout." ...@@ -1826,12 +1860,16 @@ properly. BODY shall not contain a timeout."
(ert-deftest tramp-test03-file-name-defaults () (ert-deftest tramp-test03-file-name-defaults ()
"Check default values for some methods." "Check default values for some methods."
;; Default values in tramp-adb.el. ;; Default values in tramp-adb.el.
(should (string-equal (file-remote-p "/adb::" 'host) "")) (when (assoc "adb" tramp-methods)
(should (string-equal (file-remote-p "/adb::" 'host) "")))
;; Default values in tramp-ftp.el. ;; Default values in tramp-ftp.el.
(when (assoc "ftp" tramp-methods)
(should (string-equal (file-remote-p "/-:ftp.host:" 'method) "ftp")) (should (string-equal (file-remote-p "/-:ftp.host:" 'method) "ftp"))
(dolist (u '("ftp" "anonymous")) (dolist (u '("ftp" "anonymous"))
(should (string-equal (file-remote-p (format "/-:%s@:" u) 'method) "ftp"))) (should
(string-equal (file-remote-p (format "/-:%s@:" u) 'method) "ftp"))))
;; Default values in tramp-sh.el and tramp-sudoedit.el. ;; Default values in tramp-sh.el and tramp-sudoedit.el.
(when (assoc "su" tramp-methods)
(dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name))) (dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name)))
(should (should
(string-equal (file-remote-p (format "/-:root@%s:" h) 'method) "su"))) (string-equal (file-remote-p (format "/-:root@%s:" h) 'method) "su")))
...@@ -1841,9 +1879,11 @@ properly. BODY shall not contain a timeout." ...@@ -1841,9 +1879,11 @@ properly. BODY shall not contain a timeout."
(string-equal (file-remote-p (format "/%s::" m) 'host) (system-name)))) (string-equal (file-remote-p (format "/%s::" m) 'host) (system-name))))
(dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp" "nc")) (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp" "nc"))
(should (should
(string-equal (file-remote-p (format "/%s::" m) 'user) (user-login-name)))) (string-equal
(file-remote-p (format "/%s::" m) 'user) (user-login-name)))))
;; Default values in tramp-smb.el. ;; Default values in tramp-smb.el.
(should (string-equal (file-remote-p "/smb::" 'user) nil))) (when (assoc "smb" tramp-methods)
(should (string-equal (file-remote-p "/smb::" 'user) nil))))
;; The following test is inspired by Bug#30946. ;; The following test is inspired by Bug#30946.
(ert-deftest tramp-test03-file-name-host-rules () (ert-deftest tramp-test03-file-name-host-rules ()
...@@ -1898,7 +1938,10 @@ properly. BODY shall not contain a timeout." ...@@ -1898,7 +1938,10 @@ properly. BODY shall not contain a timeout."
(ert-deftest tramp-test04-substitute-in-file-name () (ert-deftest tramp-test04-substitute-in-file-name ()
"Check `substitute-in-file-name'." "Check `substitute-in-file-name'."
(should (string-equal (substitute-in-file-name "/method:host:///foo") "/foo")) ;; Suppress method name check.
(let ((tramp-methods (cons '("method") tramp-methods)))
(should
(string-equal (substitute-in-file-name "/method:host:///foo") "/foo"))
(should (should
(string-equal (string-equal
(substitute-in-file-name "/method:host://foo") "/method:host:/foo")) (substitute-in-file-name "/method:host://foo") "/method:host:/foo"))
...@@ -1910,7 +1953,8 @@ properly. BODY shall not contain a timeout." ...@@ -1910,7 +1953,8 @@ properly. BODY shall not contain a timeout."
;; Quoting local part. ;; Quoting local part.
(should (should
(string-equal (string-equal
(substitute-in-file-name "/method:host:/:///foo") "/method:host:/:///foo")) (substitute-in-file-name "/method:host:/:///foo")
"/method:host:/:///foo"))
(should (should
(string-equal (string-equal
(substitute-in-file-name "/method:host:/://foo") "/method:host:/://foo")) (substitute-in-file-name "/method:host:/://foo") "/method:host:/://foo"))
...@@ -1929,7 +1973,8 @@ properly. BODY shall not contain a timeout." ...@@ -1929,7 +1973,8 @@ properly. BODY shall not contain a timeout."
(string-equal (string-equal
(substitute-in-file-name "/method:host:/~foo") "/method:host:/~foo")) (substitute-in-file-name "/method:host:/~foo") "/method:host:/~foo"))
(should (should
(string-equal (substitute-in-file-name "/method:host:/path//~foo") "/~foo")) (string-equal
(substitute-in-file-name "/method:host:/path//~foo") "/~foo"))
;; (substitute-in-file-name "/path/~foo") expands only for a local ;; (substitute-in-file-name "/path/~foo") expands only for a local
;; user "foo" to "/~foo"". Otherwise, it doesn't expand. ;; user "foo" to "/~foo"". Otherwise, it doesn't expand.
(should (should
...@@ -1939,7 +1984,8 @@ properly. BODY shall not contain a timeout." ...@@ -1939,7 +1984,8 @@ properly. BODY shall not contain a timeout."
;; Quoting local part. ;; Quoting local part.
(should (should
(string-equal (string-equal
(substitute-in-file-name "/method:host:/://~foo") "/method:host:/://~foo")) (substitute-in-file-name "/method:host:/://~foo")
"/method:host:/://~foo"))
(should (should
(string-equal (string-equal
(substitute-in-file-name "/method:host:/:/~foo") "/method:host:/:/~foo")) (substitute-in-file-name "/method:host:/:/~foo") "/method:host:/:/~foo"))
...@@ -1979,10 +2025,12 @@ properly. BODY shall not contain a timeout." ...@@ -1979,10 +2025,12 @@ properly. BODY shall not contain a timeout."
(should (should
(string-equal (string-equal
(substitute-in-file-name "/method:host:/:/path/$$FOO") (substitute-in-file-name "/method:host:/:/path/$$FOO")
"/method:host:/:/path/$$FOO")))) "/method:host:/:/path/$$FOO")))))
(ert-deftest tramp-test05-expand-file-name () (ert-deftest tramp-test05-expand-file-name ()
"Check `expand-file-name'." "Check `expand-file-name'."
;; Suppress method name check.
(let ((tramp-methods (cons '("method") tramp-methods)))
(should (should
(string-equal (string-equal
(expand-file-name "/method:host:/path/./file") "/method:host:/path/file")) (expand-file-name "/method:host:/path/./file") "/method:host:/path/file"))
...@@ -2012,7 +2060,7 @@ properly. BODY shall not contain a timeout." ...@@ -2012,7 +2060,7 @@ properly. BODY shall not contain a timeout."
(should (should
(string-equal (string-equal
(expand-file-name "/method:host:/:/~/path/./file") (expand-file-name "/method:host:/:/~/path/./file")
"/method:host:/:/~/path/file"))) "/method:host:/:/~/path/file"))))
;; The following test is inspired by Bug#26911 and Bug#34834. They ;; The following test is inspired by Bug#26911 and Bug#34834. They
;; are rather bugs in `expand-file-name', and it fails for all Emacs ;; are rather bugs in `expand-file-name', and it fails for all Emacs
...@@ -2042,6 +2090,8 @@ properly. BODY shall not contain a timeout." ...@@ -2042,6 +2090,8 @@ properly. BODY shall not contain a timeout."
"Check `directory-file-name'. "Check `directory-file-name'.
This checks also `file-name-as-directory', `file-name-directory', This checks also `file-name-as-directory', `file-name-directory',
`file-name-nondirectory' and `unhandled-file-name-directory'." `file-name-nondirectory' and `unhandled-file-name-directory'."
;; Suppress method name check.
(let ((tramp-methods (cons '("method") tramp-methods)))
(should (should
(string-equal (string-equal
(directory-file-name "/method:host:/path/to/file") (directory-file-name "/method:host:/path/to/file")
...@@ -2079,11 +2129,12 @@ This checks also `file-name-as-directory', `file-name-directory', ...@@ -2079,11 +2129,12 @@ This checks also `file-name-as-directory', `file-name-directory',
(string-equal (string-equal
(file-name-directory "/method:host:path/to") "/method:host:path/")) (file-name-directory "/method:host:path/to") "/method:host:path/"))
(should (should
(string-equal (file-name-nondirectory "/method:host:/path/to/file") "file")) (string-equal
(file-name-nondirectory "/method:host:/path/to/file") "file"))
(should (should
(string-equal (file-name-nondirectory "/method:host:/path/to/file/") "")) (string-equal (file-name-nondirectory "/method:host:/path/to/file/") ""))
(should-not (should-not
(unhandled-file-name-directory "/method:host:/path/to/file")) (unhandled-file-name-directory "/method:host:/path/to/file")))
;; Bug#10085. ;; Bug#10085.
(when (tramp--test-enabled) ;; Packages like tramp-gvfs.el might be disabled. (when (tramp--test-enabled) ;; Packages like tramp-gvfs.el might be disabled.
...@@ -3968,7 +4019,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ...@@ -3968,7 +4019,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; name handlers since Emacs 27. ;; name handlers since Emacs 27.
(skip-unless (tramp--test-emacs27-p)) (skip-unless (tramp--test-emacs27-p))
(tramp--test-instrument-test-case 0
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let ((default-directory tramp-test-temporary-file-directory) (let ((default-directory tramp-test-temporary-file-directory)
(tmp-name (tramp--test-make-temp-name nil quoted)) (tmp-name (tramp--test-make-temp-name nil quoted))
...@@ -4097,7 +4147,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ...@@ -4097,7 +4147,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Cleanup. ;; Cleanup.
(ignore-errors (delete-process proc)) (ignore-errors (delete-process proc))
(ignore-errors (kill-buffer stderr))))))))) (ignore-errors (kill-buffer stderr))))))))
(ert-deftest tramp-test31-interrupt-process () (ert-deftest tramp-test31-interrupt-process ()
"Check `interrupt-process'." "Check `interrupt-process'."
...@@ -4107,7 +4157,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ...@@ -4107,7 +4157,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Since Emacs 26.1. ;; Since Emacs 26.1.
(skip-unless (boundp 'interrupt-process-functions)) (skip-unless (boundp 'interrupt-process-functions))
(let ((default-directory tramp-test-temporary-file-directory) ;; We must use `file-truename' for the temporary directory, in
;; order to establish the connection prior running an asynchronous
;; process.
(let ((default-directory (file-truename tramp-test-temporary-file-directory))
kill-buffer-query-functions proc) kill-buffer-query-functions proc)
(unwind-protect (unwind-protect
(with-temp-buffer (with-temp-buffer
...@@ -4602,7 +4655,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ...@@ -4602,7 +4655,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(skip-unless (tramp--test-sh-p)) (skip-unless (tramp--test-sh-p))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let* ((default-directory tramp-test-temporary-file-directory) ;; We must use `file-truename' for the temporary directory, in
;; order to establish the connection prior running an asynchronous
;; process.
(let* ((default-directory