procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Better check for multi-hops when calling direct async processes

Browse source 
* lisp/net/tramp-sh.el (tramp-multi-hop-p, tramp-compute-multi-hops):
Move them from here ...

* lisp/net/tramp.el (tramp-multi-hop-p, tramp-compute-multi-hops): ... here.
(tramp-direct-async-process-p): Use `tramp-compute-multi-hops'.
This commit is contained in:
Michael Albinus 2020-08-19 13:19:19 +02:00
parent 18e6a0b5c0
commit 3b8dfc46ce
2 changed files with 100 additions and 101 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

98
lisp/net/tramp-sh.el
View file

@ -4781,104 +4781,6 @@ Goes through the list `tramp-inline-compress-commands'."
(tramp-message
vec 2 "Couldn't find an inline transfer compress command")))))
;;;###tramp-autoload
(defun tramp-multi-hop-p (vec)
"Whether the method of VEC is capable of multi-hops."
(and (tramp-sh-file-name-handler-p vec)
(not (tramp-get-method-parameter vec 'tramp-copy-program))))
(defun tramp-compute-multi-hops (vec)
"Expands VEC according to `tramp-default-proxies-alist'."
(let ((saved-tdpa tramp-default-proxies-alist)
(target-alist `(,vec))
(hops (or (tramp-file-name-hop vec) ""))
(item vec)
choices proxy)
;; Ad-hoc proxy definitions.
(dolist (proxy (reverse (split-string hops tramp-postfix-hop-regexp 'omit)))
(let* ((host-port (tramp-file-name-host-port item))
(user-domain (tramp-file-name-user-domain item))
(proxy (concat
tramp-prefix-format proxy tramp-postfix-host-format))
(entry
(list (and (stringp host-port)
(concat "^" (regexp-quote host-port) "$"))
(and (stringp user-domain)
(concat "^" (regexp-quote user-domain) "$"))
(propertize proxy 'tramp-ad-hoc t))))
(tramp-message vec 5 "Add %S to `tramp-default-proxies-alist'" entry)
;; Add the hop.
(add-to-list 'tramp-default-proxies-alist entry)
(setq item (tramp-dissect-file-name proxy))))
;; Save the new value.
(when (and hops tramp-save-ad-hoc-proxies)
(customize-save-variable
'tramp-default-proxies-alist tramp-default-proxies-alist))
;; Look for proxy hosts to be passed.
(setq choices tramp-default-proxies-alist)
(while choices
(setq item (pop choices)
proxy (eval (nth 2 item)))
(when (and
;; Host.
(string-match-p
(or (eval (nth 0 item)) "")
(or (tramp-file-name-host-port (car target-alist)) ""))
;; User.
(string-match-p
(or (eval (nth 1 item)) "")
(or (tramp-file-name-user-domain (car target-alist)) "")))
(if (null proxy)
;; No more hops needed.
(setq choices nil)
;; Replace placeholders.
(setq proxy
(format-spec
proxy
(format-spec-make
?u (or (tramp-file-name-user (car target-alist)) "")
?h (or (tramp-file-name-host (car target-alist)) ""))))
(with-parsed-tramp-file-name proxy l
;; Add the hop.
(push l target-alist)
;; Start next search.
(setq choices tramp-default-proxies-alist)))))
;; Foreign and out-of-band methods are not supported for multi-hops.
(when (cdr target-alist)
(setq choices target-alist)
(while (setq item (pop choices))
(unless (tramp-multi-hop-p item)
(setq tramp-default-proxies-alist saved-tdpa)
(tramp-user-error
vec "Method `%s' is not supported for multi-hops."
(tramp-file-name-method item)))))
;; 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 (or 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-p previous-host host))
(setq tramp-default-proxies-alist saved-tdpa)
(tramp-user-error
vec "Host name `%s' does not match `%s'" host previous-host))
(setq previous-host (concat "^" (regexp-quote host) "$")))))
;; Result.
target-alist))
(defun tramp-ssh-controlmaster-options (vec)
"Return the Control* arguments of the local ssh."
(cond

103
lisp/net/tramp.el
View file

@ -3634,12 +3634,109 @@ User is always nil."
(delete-file local-copy)))))
t)))
(defun tramp-multi-hop-p (vec)
"Whether the method of VEC is capable of multi-hops."
(and (tramp-sh-file-name-handler-p vec)
(not (tramp-get-method-parameter vec 'tramp-copy-program))))
(defun tramp-compute-multi-hops (vec)
"Expands VEC according to `tramp-default-proxies-alist'."
(let ((saved-tdpa tramp-default-proxies-alist)
(target-alist `(,vec))
(hops (or (tramp-file-name-hop vec) ""))
(item vec)
choices proxy)
;; Ad-hoc proxy definitions.
(dolist (proxy (reverse (split-string hops tramp-postfix-hop-regexp 'omit)))
(let* ((host-port (tramp-file-name-host-port item))
(user-domain (tramp-file-name-user-domain item))
(proxy (concat
tramp-prefix-format proxy tramp-postfix-host-format))
(entry
(list (and (stringp host-port)
(concat "^" (regexp-quote host-port) "$"))
(and (stringp user-domain)
(concat "^" (regexp-quote user-domain) "$"))
(propertize proxy 'tramp-ad-hoc t))))
(tramp-message vec 5 "Add %S to `tramp-default-proxies-alist'" entry)
;; Add the hop.
(add-to-list 'tramp-default-proxies-alist entry)
(setq item (tramp-dissect-file-name proxy))))
;; Save the new value.
(when (and hops tramp-save-ad-hoc-proxies)
(customize-save-variable
'tramp-default-proxies-alist tramp-default-proxies-alist))
;; Look for proxy hosts to be passed.
(setq choices tramp-default-proxies-alist)
(while choices
(setq item (pop choices)
proxy (eval (nth 2 item)))
(when (and
;; Host.
(string-match-p
(or (eval (nth 0 item)) "")
(or (tramp-file-name-host-port (car target-alist)) ""))
;; User.
(string-match-p
(or (eval (nth 1 item)) "")
(or (tramp-file-name-user-domain (car target-alist)) "")))
(if (null proxy)
;; No more hops needed.
(setq choices nil)
;; Replace placeholders.
(setq proxy
(format-spec
proxy
(format-spec-make
?u (or (tramp-file-name-user (car target-alist)) "")
?h (or (tramp-file-name-host (car target-alist)) ""))))
(with-parsed-tramp-file-name proxy l
;; Add the hop.
(push l target-alist)
;; Start next search.
(setq choices tramp-default-proxies-alist)))))
;; Foreign and out-of-band methods are not supported for multi-hops.
(when (cdr target-alist)
(setq choices target-alist)
(while (setq item (pop choices))
(unless (tramp-multi-hop-p item)
(setq tramp-default-proxies-alist saved-tdpa)
(tramp-user-error
vec "Method `%s' is not supported for multi-hops."
(tramp-file-name-method item)))))
;; 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 (or 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-p previous-host host))
(setq tramp-default-proxies-alist saved-tdpa)
(tramp-user-error
vec "Host name `%s' does not match `%s'" host previous-host))
(setq previous-host (concat "^" (regexp-quote host) "$")))))
;; Result.
target-alist))
(defun tramp-direct-async-process-p (&rest args)
"Whether direct async `make-process' can be called."
(let ((v (tramp-dissect-file-name default-directory)))
(and (tramp-get-connection-property v"direct-async-process" nil)
(not (tramp-multi-hop-p v))
(not (plist-get args :stderr)))))
(and (tramp-get-connection-property v "direct-async-process" nil)
(= (length (tramp-compute-multi-hops v)) 1)
(not (plist-get args :stderr)))))
;; We use BUFFER also as connection buffer during setup. Because of
;; this, its original contents must be saved, and restored once