diff options
| -rw-r--r-- | doc/misc/tramp.texi | 6 | ||||
| -rw-r--r-- | lisp/net/tramp-adb.el | 2 | ||||
| -rw-r--r-- | lisp/net/tramp-archive.el | 4 | ||||
| -rw-r--r-- | lisp/net/tramp-compat.el | 7 | ||||
| -rw-r--r-- | lisp/net/tramp-gvfs.el | 2 | ||||
| -rw-r--r-- | lisp/net/tramp-sh.el | 38 | ||||
| -rw-r--r-- | lisp/net/tramp.el | 35 | ||||
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 23 |
8 files changed, 79 insertions, 38 deletions
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 31439043435..f0ea073ed09 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1408,8 +1408,10 @@ Opening @file{@trampfn{sudo,randomhost.your.domain,}} first connects to @samp{randomhost.your.domain} via @code{ssh} under your account name, and then performs @code{sudo -u root} on that host. -It is key for the sudo method in the above example to be applied on -the host after reaching it and not on the local host. +It is key for the @option{sudo} method in the above example to be +applied on the host after reaching it and not on the local host. +@value{tramp} checks therefore, that the host name for such hops +matches the host name of the previous hop. @var{host}, @var{user} and @var{proxy} can also take Lisp forms. These forms when evaluated must return either a string or @code{nil}. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index fbf6196ca46..f8edb27c516 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -999,7 +999,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (when p (if (yes-or-no-p "A command is running. Kill it? ") (ignore-errors (kill-process p)) - (tramp-compat-user-error p "Shell command in progress"))) + (tramp-user-error p "Shell command in progress"))) (if current-buffer-p (progn diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 0b8e8da9761..448cfca2ca1 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -311,7 +311,7 @@ pass to the OPERATION." (tramp-archive-run-real-handler operation args) ;; Now run the handler. (unless tramp-archive-enabled - (tramp-compat-user-error nil "Package `tramp-archive' not supported")) + (tramp-user-error nil "Package `tramp-archive' not supported")) (let ((tramp-methods (cons `(,tramp-archive-method) tramp-methods)) (tramp-gvfs-methods tramp-archive-all-gvfs-methods) ;; Set uid and gid. gvfsd-archive could do it, but it doesn't. @@ -398,7 +398,7 @@ hexified archive name as host, and the localname. The archive name is kept in slot `hop'" (save-match-data (unless (tramp-archive-file-name-p name) - (tramp-compat-user-error nil "Not an archive file name: \"%s\"" name)) + (tramp-user-error nil "Not an archive file name: \"%s\"" name)) (let* ((localname (tramp-archive-file-name-localname name)) (archive (file-truename (tramp-archive-file-name-archive name))) (vec (make-tramp-file-name diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 4f564e6eb5c..aa0c99bf9cf 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -97,13 +97,6 @@ Add the extension of F, if existing." process-name)))) (setq result t))))))))) -;; `user-error' has appeared in Emacs 24.3. -(defsubst tramp-compat-user-error (vec-or-proc format &rest args) - "Signal a pilot error." - (apply - 'tramp-error vec-or-proc - (if (fboundp 'user-error) 'user-error 'error) format args)) - ;; `default-toplevel-value' has been declared in Emacs 24.4. (unless (fboundp 'default-toplevel-value) (defalias 'default-toplevel-value 'symbol-value)) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index d0385f3ba28..33af124458d 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -751,7 +751,7 @@ Operations not mentioned here will be handled by the default Emacs primitives.") First arg specifies the OPERATION, second arg is a list of arguments to pass to the OPERATION." (unless tramp-gvfs-enabled - (tramp-compat-user-error nil "Package `tramp-gvfs' not supported")) + (tramp-user-error nil "Package `tramp-gvfs' not supported")) (let ((fn (assoc operation tramp-gvfs-file-name-handler-alist))) (if fn (save-match-data (apply (cdr fn) args)) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 4cdc39e0b6a..63275448ef8 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -327,7 +327,6 @@ The string is used in `tramp-methods'.") (add-to-list 'tramp-methods `("plink" (tramp-login-program "plink") - ;; ("%h") must be a single element, see `tramp-compute-multi-hops'. (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("-t") ("%h") ("\"") (,(format @@ -4636,25 +4635,24 @@ Goes through the list `tramp-inline-compress-commands'." "Method `%s' is not supported for multi-hops." (tramp-file-name-method item))))) - ;; In case the host name is not used for the remote shell - ;; command, the user could be misguided by applying a random - ;; host name. - (let* ((v (car target-alist)) - (method (tramp-file-name-method v)) - (host (tramp-file-name-host v))) - (unless - (or - ;; There are multi-hops. - (cdr target-alist) - ;; The host name is used for the remote shell command. - (member '("%h") (tramp-get-method-parameter v 'tramp-login-args)) - ;; The host is local. We cannot use `tramp-local-host-p' - ;; here, because it opens a connection as well. - (string-match tramp-local-host-regexp host)) - (tramp-error - v 'file-error - "Host `%s' looks like a remote host, `%s' can only use the local host" - host method))) + ;; Some methods ("su", "sg", "sudo", "doas", "ksu") do not use the + ;; host name in their command template. In this case, the remote + ;; file name must use either a local host name (first hop), or a + ;; host name matching the previous hop. + (let ((previous-host tramp-local-host-regexp)) + (setq choices target-alist) + (while (setq item (pop choices)) + (let ((host (tramp-file-name-host item))) + (unless + (or + ;; The host name is used for the remote shell command. + (member + '("%h") (tramp-get-method-parameter item 'tramp-login-args)) + ;; The host name must match previous hop. + (string-match previous-host host)) + (tramp-user-error + item "Host name `%s' does not match `%s'" host previous-host)) + (setq previous-host (concat "^" (regexp-quote host) "$"))))) ;; Result. target-alist)) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 4497802d770..43b5e77428a 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -689,7 +689,7 @@ Used in user option `tramp-syntax'. There are further variables to be set, depending on VALUE." ;; Check allowed values. (unless (memq value (tramp-syntax-values)) - (tramp-compat-user-error "Wrong `tramp-syntax' %s" tramp-syntax)) + (tramp-user-error "Wrong `tramp-syntax' %s" tramp-syntax)) ;; Cleanup existing buffers. (unless (eq (symbol-value symbol) value) (tramp-cleanup-all-buffers)) @@ -1348,7 +1348,7 @@ to their default values. For the other file name parts, no default values are used." (save-match-data (unless (tramp-tramp-file-p name) - (tramp-compat-user-error nil "Not a Tramp file name: \"%s\"" name)) + (tramp-user-error nil "Not a Tramp file name: \"%s\"" name)) (if (not (string-match (nth 0 tramp-file-name-structure) name)) (error "`tramp-file-name-structure' didn't match!") (let ((method (match-string (nth 1 tramp-file-name-structure) name)) @@ -1608,12 +1608,12 @@ ARGUMENTS to actually emit the message (if applicable)." (regexp-opt '("tramp-backtrace" "tramp-compat-funcall" - "tramp-compat-user-error" "tramp-condition-case-unless-debug" "tramp-debug-message" "tramp-error" "tramp-error-with-buffer" - "tramp-message") + "tramp-message" + "tramp-user-error") t) "$") fn))) @@ -1753,6 +1753,31 @@ an input event arrives. The other arguments are passed to `tramp-error'." (when (tramp-file-name-equal-p vec (car tramp-current-connection)) (setcdr tramp-current-connection (current-time))))))) +;; We must make it a defun, because it is used earlier already. +(defun tramp-user-error (vec-or-proc fmt-string &rest arguments) + "Signal a pilot error." + (unwind-protect + (apply + 'tramp-error vec-or-proc + ;; `user-error' has appeared in Emacs 24.3. + (if (fboundp 'user-error) 'user-error 'error) fmt-string arguments) + ;; Save exit. + (when (and tramp-message-show-message + (not (zerop tramp-verbose)) + ;; Do not show when flagged from outside. + (not (tramp-completion-mode-p)) + ;; Show only when Emacs has started already. + (current-message)) + (let ((enable-recursive-minibuffers t)) + ;; `tramp-error' does not show messages. So we must do it ourselves. + (apply 'message fmt-string arguments) + (discard-input) + (sit-for 30) + ;; Reset timestamp. It would be wrong after waiting for a while. + (when + (tramp-file-name-equal-p vec-or-proc (car tramp-current-connection)) + (setcdr tramp-current-connection (current-time))))))) + (defmacro tramp-with-demoted-errors (vec-or-proc format &rest body) "Execute BODY while redirecting the error message to `tramp-message'. BODY is executed like wrapped by `with-demoted-errors'. FORMAT @@ -3503,7 +3528,7 @@ support symbolic links." (when p (if (yes-or-no-p "A command is running. Kill it? ") (ignore-errors (kill-process p)) - (tramp-compat-user-error p "Shell command in progress"))) + (tramp-user-error p "Shell command in progress"))) (if current-buffer-p (progn diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index dfb01126f70..5e79a4bce6f 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -1722,6 +1722,28 @@ handled properly. BODY shall not contain a timeout." ;; Default values in tramp-smb.el. (should (string-equal (file-remote-p "/smb::" 'user) nil))) +;; The following test is inspired by Bug#30946. +(ert-deftest tramp-test03-file-name-host-rules () + "Check host name rules for host-less methods." + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-sh-p)) + + ;; Host names must match rules in case the command template of a + ;; method doesn't use them. + (dolist (m '("su" "sg" "sudo" "doas" "ksu")) + ;; Single hop. The host name must match `tramp-local-host-regexp'. + (should-error + (find-file (format "/%s:foo:" m)) + :type 'user-error) + ;; Multi hop. The host name must match the previous hop. + (should-error + (find-file + (format + "%s|%s:foo:" + (substring (file-remote-p tramp-test-temporary-file-directory) nil -1) + m)) + :type 'user-error))) + (ert-deftest tramp-test04-substitute-in-file-name () "Check `substitute-in-file-name'." (should (string-equal (substitute-in-file-name "/method:host:///foo") "/foo")) @@ -1836,6 +1858,7 @@ handled properly. BODY shall not contain a timeout." ;; Mark as failed until bug has been fixed. :expected-result :failed (skip-unless (tramp--test-enabled)) + ;; These are the methods the test doesn't fail. (when (or (tramp--test-adb-p) (tramp--test-gvfs-p) (tramp-smb-file-name-p tramp-test-temporary-file-directory)) |