[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master b9340aa: Fix Bug#30946
From: |
Michael Albinus |
Subject: |
[Emacs-diffs] master b9340aa: Fix Bug#30946 |
Date: |
Thu, 29 Mar 2018 09:59:19 -0400 (EDT) |
branch: master
commit b9340aad7961c57fbd458d52e813b71f09aaa45f
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>
Fix Bug#30946
* 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.
---
doc/misc/tramp.texi | 6 ++++--
lisp/net/tramp-adb.el | 2 +-
lisp/net/tramp-archive.el | 4 ++--
lisp/net/tramp-compat.el | 7 -------
lisp/net/tramp-gvfs.el | 2 +-
lisp/net/tramp-sh.el | 38 ++++++++++++++++++--------------------
lisp/net/tramp.el | 35 ++++++++++++++++++++++++++++++-----
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 3143904..f0ea073 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -1408,8 +1408,10 @@ Opening @address@hidden,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.
address@hidden 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 fbf6196..f8edb27 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 0b8e8da..448cfca 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 4f564e6..aa0c99b 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 d0385f3..33af124 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 4cdc39e..6327544 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 4497802..43b5e77 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 dfb0112..5e79a4b 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))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master b9340aa: Fix Bug#30946,
Michael Albinus <=