From: Michael Albinus Date: Wed, 19 Aug 2020 11:19:19 +0000 (+0200) Subject: Better check for multi-hops when calling direct async processes X-Git-Tag: emacs-28.0.90~6514 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=3b8dfc46ce95ae657b4c33af12ad46827f29084d;p=emacs.git Better check for multi-hops when calling direct async processes * 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'. --- diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index ca43475f453..fae15fe6a8e 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -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 diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index ab52bec39eb..83ade66ee14 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -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