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.
(when (and (tramp-tramp-file-p target) ;; Don't check for a proper method.
(tramp-file-name-equal-p v (tramp-dissect-file-name target))) (let ((non-essential t))
(setq target (when (and (tramp-tramp-file-p target)
(tramp-file-name-localname (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
(tramp-dissect-file-name (expand-file-name target))))) (setq target
(tramp-file-name-localname
(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.
(when (and (tramp-tramp-file-p target) ;; Don't check for a proper method.
(tramp-file-name-equal-p v (tramp-dissect-file-name target))) (let ((non-essential t))
(setq target (when (and (tramp-tramp-file-p target)
(tramp-file-name-localname (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
(tramp-dissect-file-name (expand-file-name target))))) (setq target
(tramp-file-name-localname
(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.
(when (and (tramp-tramp-file-p target) ;; Don't check for a proper method.
(tramp-file-name-equal-p v (tramp-dissect-file-name target))) (let ((non-essential t))
(setq target (when (and (tramp-tramp-file-p target)
(tramp-file-name-localname (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
(tramp-dissect-file-name (expand-file-name target))))) (setq target
(tramp-file-name-localname
(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,89 +157,93 @@ variables, so we check the Emacs version directly." ...@@ -157,89 +157,93 @@ 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)
(with-parsed-tramp-archive-file-name tramp-archive-test-archive nil ;; Suppress method name check.
(should (string-equal method tramp-archive-method)) (let ((non-essential t))
(should-not user) (with-parsed-tramp-archive-file-name tramp-archive-test-archive nil
(should-not domain) (should (string-equal method tramp-archive-method))
(should (should-not user)
(string-equal (should-not domain)
host (should
(file-remote-p (string-equal
(tramp-archive-gvfs-file-name tramp-archive-test-archive) 'host))) host
(should (file-remote-p
(string-equal (tramp-archive-gvfs-file-name tramp-archive-test-archive) 'host)))
host (should
(url-hexify-string (concat "file://" tramp-archive-test-file-archive)))) (string-equal
(should-not port) host
(should (string-equal localname "/")) (url-hexify-string (concat "file://" tramp-archive-test-file-archive))))
(should (string-equal archive tramp-archive-test-file-archive))) (should-not port)
(should (string-equal localname "/"))
;; Localname. (should (string-equal archive tramp-archive-test-file-archive)))
(with-parsed-tramp-archive-file-name
(concat tramp-archive-test-archive "foo") nil ;; Localname.
(should (string-equal method tramp-archive-method)) (with-parsed-tramp-archive-file-name
(should-not user) (concat tramp-archive-test-archive "foo") nil
(should-not domain) (should (string-equal method tramp-archive-method))
(should (should-not user)
(string-equal (should-not domain)
host (should
(file-remote-p (string-equal
(tramp-archive-gvfs-file-name tramp-archive-test-archive) 'host))) host
(should (file-remote-p
(string-equal (tramp-archive-gvfs-file-name tramp-archive-test-archive) 'host)))
host (should
(url-hexify-string (concat "file://" tramp-archive-test-file-archive)))) (string-equal
(should-not port) host
(should (string-equal localname "/foo")) (url-hexify-string (concat "file://" tramp-archive-test-file-archive))))
(should (string-equal archive tramp-archive-test-file-archive))) (should-not port)
(should (string-equal localname "/foo"))
;; File archive in file archive. (should (string-equal archive tramp-archive-test-file-archive)))
(let* ((tramp-archive-test-file-archive
(concat tramp-archive-test-archive "baz.tar")) ;; File archive in file archive.
(tramp-archive-test-archive (let* ((tramp-archive-test-file-archive
(file-name-as-directory tramp-archive-test-file-archive)) (concat tramp-archive-test-archive "baz.tar"))
(tramp-methods (cons `(,tramp-archive-method) tramp-methods)) (tramp-archive-test-archive
(tramp-gvfs-methods tramp-archive-all-gvfs-methods)) (file-name-as-directory tramp-archive-test-file-archive))
(unwind-protect (tramp-methods (cons `(,tramp-archive-method) tramp-methods))
(with-parsed-tramp-archive-file-name (tramp-gvfs-methods tramp-archive-all-gvfs-methods))
(expand-file-name "bar" tramp-archive-test-archive) nil (unwind-protect
(should (string-equal method tramp-archive-method)) (with-parsed-tramp-archive-file-name
(should-not user) (expand-file-name "bar" tramp-archive-test-archive) nil
(should-not domain) (should (string-equal method tramp-archive-method))
(should (should-not user)
(string-equal (should-not domain)
host (should
(file-remote-p (string-equal
(tramp-archive-gvfs-file-name tramp-archive-test-archive) 'host))) host
;; We reimplement the logic of tramp-archive.el here. Don't (file-remote-p
;; know, whether it is worth the test. (tramp-archive-gvfs-file-name tramp-archive-test-archive)
(should 'host)))
(string-equal ;; We reimplement the logic of tramp-archive.el here.
host ;; Don't know, whether it is worth the test.
(url-hexify-string (should
(concat (string-equal
(tramp-gvfs-url-file-name host
(tramp-make-tramp-file-name (url-hexify-string
tramp-archive-method (concat
;; User and Domain. (tramp-gvfs-url-file-name
nil nil (tramp-make-tramp-file-name
;; Host. tramp-archive-method
(url-hexify-string ;; User and Domain.
(concat nil nil
"file://" ;; Host.
;; `directory-file-name' does not leave file archive (url-hexify-string
;; boundaries. So we must cut the trailing slash (concat
;; ourselves. "file://"
(substring ;; `directory-file-name' does not leave file
(file-name-directory tramp-archive-test-file-archive) 0 -1))) ;; archive boundaries. So we must cut the
nil "/")) ;; trailing slash ourselves.
(file-name-nondirectory tramp-archive-test-file-archive))))) (substring
(should-not port) (file-name-directory tramp-archive-test-file-archive)
(should (string-equal localname "/bar")) 0 -1)))
(should (string-equal archive tramp-archive-test-file-archive))) nil "/"))
(file-name-nondirectory tramp-archive-test-file-archive)))))
(should-not port)
(should (string-equal localname "/bar"))
(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'."
......
This diff is collapsed.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment