* doc/misc/tramp.texi (Multi-hops): Mention host name checks.
* lisp/net/tramp.el (tramp-set-syntax, tramp-dissect-file-name)
(tramp-debug-message, tramp-handle-shell-command):
* lisp/net/tramp-adb.el (tramp-adb-handle-shell-command):
* lisp/net/tramp-archive.el (tramp-archive-file-name-handler)
(tramp-archive-dissect-file-name):
* lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler): Adapt callees.
* lisp/net/tramp-compat.el (tramp-compat-user-error): Move defsubst ---
* lisp/net/tramp-sh.el (tramp-compute-multi-hops): Check for proper
host names in multi-hop. (Bug#30946)
* lisp/net/tramp.el (tramp-user-error): ... here. Make it a defun.
* test/lisp/net/tramp-tests.el (tramp-test03-file-name-host-rules):
New test.
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}.
(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
(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.
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
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))
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))
(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
"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))
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))
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))
(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)))
(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
(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
;; 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"))
;; 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))
projects / emacs.git / commitdiff