From: Michael Albinus Date: Sun, 23 Aug 2020 11:30:43 +0000 (+0200) Subject: Rework direct async processes in Tramp X-Git-Tag: emacs-28.0.90~6447 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=4aff89ece6d9ceee882375879518b71ca6a89a70;p=emacs.git Rework direct async processes in Tramp * doc/misc/tramp.texi (Remote processes): Precise restrictions for direct async processes. * lisp/net/tramp.el (tramp-methods): Adapt docstring. (tramp-direct-async-process-p): Make it more precise. (tramp-handle-make-process): Rewrite, based on `make-process'. * test/lisp/net/tramp-tests.el (tramp-test-temporary-file-directory): Add `tramp-direct-async-args` for mock method. (tramp-test29-start-file-process, tramp-test30-make-process): Use weaker regexp checking "foo". (tramp-test30-make-process): Do not check stderr for direct async processes. (tramp--test--deftest-direct-async-process): New defmacro. (tramp-test29-start-file-process-direct-async) (tramp-test30-make-process-direct-async): New tests. --- diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index c1a66d02512..bdf3b403d80 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -239,7 +239,7 @@ included in the file name portion, @value{tramp} sends the login name followed by a newline. @item -The remote host may then prompt for a password or pass phrase (for +The remote host may then prompt for a password or passphrase (for @command{rsh} or for @command{telnet}). @value{tramp} displays the password prompt in the minibuffer. @value{tramp} then sends whatever is entered to the remote host, followed by a newline. @@ -3563,9 +3563,8 @@ which must be set to a non-@code{nil} value. Example: Using direct asynchronous processes in @value{tramp} is not possible, if the remote host is connected via multiple hops -(@pxref{Multi-hops}), or the @code{make-process} / -@code{start-file-process} call uses a stderr stream. In this case, -@value{tramp} falls back to its classical implementation. +(@pxref{Multi-hops}). In this case, @value{tramp} falls back to its +classical implementation. Furthermore, this approach has the following limitations: @@ -3575,8 +3574,10 @@ It works only for connection methods defined in @file{tramp-sh.el} and @file{tramp-adb.el}. @item -It does not support interactive user authentication, like password -handling. +It does not support interactive user authentication. With +@option{ssh}-based methods, this can be avoided by using a password +agent like @command{ssh-agent}, using public key authentication, or +using @code{ControlMaster} options. @item It cannot be killed via @code{interrupt-process}. @@ -3584,6 +3585,9 @@ It cannot be killed via @code{interrupt-process}. @item It does not report the remote terminal name via @code{process-tty-name}. +@item +It does not set process property @code{remote-pid}. + @item It does not use @code{tramp-remote-path} and @code{tramp-remote-process-environment}. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 83ade66ee14..28067faba30 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -248,6 +248,10 @@ pair of the form (KEY VALUE). The following KEYs are defined: parameters to suppress diagnostic messages, in order not to tamper the process output. + * `tramp-direct-async-args' + An additional argument when a direct asynchronous process is + started. Used so far only in the \"mock\" method of tramp-tests.el. + * `tramp-copy-program' This specifies the name of the program to use for remotely copying the file; this might be the absolute filename of scp or the name of @@ -3733,26 +3737,29 @@ User is always nil." (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) - (= (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 -;; connection has been setup. + (let ((v (tramp-dissect-file-name default-directory)) + (buffer (plist-get args :buffer)) + (stderr (plist-get args :stderr))) + (and ;; It has been indicated. + (tramp-get-connection-property v "direct-async-process" nil) + ;; There's no multi-hop. + (or (not (tramp-multi-hop-p v)) + (= (length (tramp-compute-multi-hops v)) 1)) + ;; There's no remote stdout or stderr file. + (or (not (stringp buffer)) (not (tramp-tramp-file-p buffer))) + (or (not (stringp stderr)) (not (tramp-tramp-file-p stderr)))))) + (defun tramp-handle-make-process (&rest args) "An alternative `make-process' implementation for Tramp files. It does not support `:stderr'." (when args (with-parsed-tramp-file-name (expand-file-name default-directory) nil - (let ((name (plist-get args :name)) + (let ((default-directory (tramp-compat-temporary-file-directory)) + (name (plist-get args :name)) (buffer (plist-get args :buffer)) (command (plist-get args :command)) - ;; FIXME: `:coding' shall be used. (coding (plist-get args :coding)) (noquery (plist-get args :noquery)) - ;; FIXME: `:connection-type' shall be used. (connection-type (plist-get args :connection-type)) (filter (plist-get args :filter)) (sentinel (plist-get args :sentinel)) @@ -3775,122 +3782,77 @@ It does not support `:stderr'." (signal 'wrong-type-argument (list #'functionp filter))) (unless (or (null sentinel) (functionp sentinel)) (signal 'wrong-type-argument (list #'functionp sentinel))) - (when stderr - (signal - 'user-error - (list - "Stderr not supported for direct remote asynchronous processes" - stderr))) + (unless (or (null stderr) (bufferp stderr)) + (signal 'wrong-type-argument (list #'stringp stderr))) (let* ((buffer (if buffer (get-buffer-create buffer) ;; BUFFER can be nil. We use a temporary buffer. (generate-new-buffer tramp-temp-buffer-name))) - (command (append `("cd" ,localname "&&") - (mapcar #'tramp-shell-quote-argument command))) - (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer))) - (name1 name) - (i 0) - ;; We do not want to raise an error when `make-process' - ;; has been started several times in `eshell' and - ;; friends. - tramp-current-connection - p) - - (while (get-process name1) - ;; NAME must be unique as process name. - (setq i (1+ i) - name1 (format "%s<%d>" name i))) - (setq name name1) - ;; Set the new process properties. - (tramp-set-connection-property v "process-name" name) - (tramp-set-connection-property v "process-buffer" buffer) + (command + (mapconcat + #'identity (append `("cd" ,localname "&&") command) " "))) ;; Check for `tramp-sh-file-name-handler', because something ;; is different between tramp-adb.el and tramp-sh.el. - (with-current-buffer (tramp-get-connection-buffer v) - (unwind-protect - (let* ((sh-file-name-handler-p (tramp-sh-file-name-handler-p v)) - (login-program - (tramp-get-method-parameter v 'tramp-login-program)) - (login-args - (tramp-get-method-parameter v 'tramp-login-args)) - (async-args - (tramp-get-method-parameter v 'tramp-async-args)) - ;; We don't create the temporary file. In - ;; fact, it is just a prefix for the - ;; ControlPath option of ssh; the real - ;; temporary file has another name, and it is - ;; created and protected by ssh. It is also - ;; removed by ssh when the connection is - ;; closed. The temporary file name is cached - ;; in the main connection process, therefore - ;; we cannot use `tramp-get-connection-process'. - (tmpfile - (when sh-file-name-handler-p - (with-tramp-connection-property - (tramp-get-process v) "temp-file" - (tramp-compat-make-temp-name)))) - (options - (when sh-file-name-handler-p - (tramp-compat-funcall - 'tramp-ssh-controlmaster-options v))) - spec) - - ;; Replace `login-args' place holders. - (setq - spec (format-spec-make ?t tmpfile) - options (format-spec (or options "") spec) - spec (format-spec-make - ?h (or host "") ?u (or user "") ?p (or port "") - ?c options ?l "") - ;; Add arguments for asynchronous processes. - login-args (append async-args login-args) - ;; Expand format spec. - login-args - (tramp-compat-flatten-tree - (mapcar - (lambda (x) - (setq x (mapcar (lambda (y) (format-spec y spec)) x)) - (unless (member "" x) x)) - login-args)) - ;; Split ControlMaster options. - login-args - (tramp-compat-flatten-tree - (mapcar (lambda (x) (split-string x " ")) login-args)) - p (apply - #'start-process - name buffer login-program (append login-args command))) - - (tramp-message v 6 "%s" (string-join (process-command p) " ")) - ;; Set sentinel and filter. - (when sentinel - (set-process-sentinel p sentinel)) - (when filter - (set-process-filter p filter)) - ;; Set query flag and process marker for this - ;; process. We ignore errors, because the - ;; process could have finished already. - (ignore-errors - (set-process-query-on-exit-flag p (null noquery)) - (set-marker (process-mark p) (point))) - ;; We must flush them here already; otherwise - ;; `rename-file', `delete-file' or - ;; `insert-file-contents' will fail. - (tramp-flush-connection-property v "process-name") - (tramp-flush-connection-property v "process-buffer") - ;; Return process. - p) - - ;; Save exit. - (if (string-match-p tramp-temp-buffer-name (buffer-name)) - (ignore-errors - (set-process-buffer p nil) - (kill-buffer (current-buffer))) - (set-buffer-modified-p bmp)) - (tramp-flush-connection-property v "process-name") - (tramp-flush-connection-property v "process-buffer")))))))) + (let* ((sh-file-name-handler-p (tramp-sh-file-name-handler-p v)) + (login-program + (tramp-get-method-parameter v 'tramp-login-program)) + (login-args + (tramp-get-method-parameter v 'tramp-login-args)) + (async-args + (tramp-get-method-parameter v 'tramp-async-args)) + (direct-async-args + (tramp-get-method-parameter v 'tramp-direct-async-args)) + ;; We don't create the temporary file. In fact, it + ;; is just a prefix for the ControlPath option of + ;; ssh; the real temporary file has another name, and + ;; it is created and protected by ssh. It is also + ;; removed by ssh when the connection is closed. The + ;; temporary file name is cached in the main + ;; connection process, therefore we cannot use + ;; `tramp-get-connection-process'. + (tmpfile + (when sh-file-name-handler-p + (with-tramp-connection-property + (tramp-get-process v) "temp-file" + (tramp-compat-make-temp-name)))) + (options + (when sh-file-name-handler-p + (tramp-compat-funcall + 'tramp-ssh-controlmaster-options v))) + spec p) + + ;; Replace `login-args' place holders. + (setq + spec (format-spec-make ?t tmpfile) + options (format-spec (or options "") spec) + spec (format-spec-make + ?h (or host "") ?u (or user "") ?p (or port "") + ?c options ?l "") + ;; Add arguments for asynchronous processes. + login-args (append async-args direct-async-args login-args) + ;; Expand format spec. + login-args + (tramp-compat-flatten-tree + (mapcar + (lambda (x) + (setq x (mapcar (lambda (y) (format-spec y spec)) x)) + (unless (member "" x) x)) + login-args)) + ;; Split ControlMaster options. + login-args + (tramp-compat-flatten-tree + (mapcar (lambda (x) (split-string x " ")) login-args)) + p (make-process + :name name :buffer buffer + :command (append `(,login-program) login-args `(,command)) + :coding coding :noquery noquery :connection-type connection-type + :filter filter :sentinel sentinel :stderr stderr)) + + (tramp-message v 6 "%s" (string-join (process-command p) " ")) + p)))))) (defun tramp-handle-make-symbolic-link (target linkname &optional ok-if-already-exists) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 561dd268f84..6bfc7f93c41 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -98,6 +98,7 @@ '("mock" (tramp-login-program "sh") (tramp-login-args (("-i"))) + (tramp-direct-async-args (("-c"))) (tramp-remote-shell "/bin/sh") (tramp-remote-shell-args ("-c")) (tramp-connection-timeout 10))) @@ -4326,9 +4327,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (with-timeout (10 (tramp--test-timeout-handler)) (while (< (- (point-max) (point-min)) (length "foo")) (while (accept-process-output proc 0 nil t)))) - ;; We cannot use `string-equal', because tramp-adb.el - ;; echoes also the sent string. - (should (string-match "\\`foo" (buffer-string)))) + (should (string-match "foo" (buffer-string)))) ;; Cleanup. (ignore-errors (delete-process proc))) @@ -4347,7 +4346,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (with-timeout (10 (tramp--test-timeout-handler)) (while (< (- (point-max) (point-min)) (length "foo")) (while (accept-process-output proc 0 nil t)))) - (should (string-equal (buffer-string) "foo"))) + (should (string-match "foo" (buffer-string)))) ;; Cleanup. (ignore-errors @@ -4369,13 +4368,35 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (with-timeout (10 (tramp--test-timeout-handler)) (while (< (- (point-max) (point-min)) (length "foo")) (while (accept-process-output proc 0 nil t)))) - ;; We cannot use `string-equal', because tramp-adb.el - ;; echoes also the sent string. - (should (string-match "\\`foo" (buffer-string)))) + (should (string-match "foo" (buffer-string)))) ;; Cleanup. (ignore-errors (delete-process proc)))))) +(defmacro tramp--test--deftest-direct-async-process + (test docstring &optional unstable) + "Define ert `TEST-direct-async' for direct async processes. +If UNSTABLE is non-nil, the test is tagged as `:unstable'." + (declare (indent 1)) + `(ert-deftest ,(intern (concat (symbol-name test) "-direct-async")) () + ,docstring + :tags (if ,unstable '(:expensive-test :unstable) '(:expensive-test)) + (skip-unless (tramp--test-enabled)) + (let ((default-directory tramp-test-temporary-file-directory) + (ert-test (ert-get-test ',test)) + (tramp-connection-properties + (cons '(nil "direct-async-process" t) tramp-connection-properties))) + (skip-unless (tramp-direct-async-process-p)) + ;; We do expect an established connection already, + ;; `file-truename' does it by side-effect. Suppress + ;; `tramp--test-enabled', in order to keep the connection. + (cl-letf (((symbol-function #'tramp--test-enabled) (lambda nil t))) + (file-truename tramp-test-temporary-file-directory) + (funcall (ert-test-body ert-test)))))) + +(tramp--test--deftest-direct-async-process tramp-test29-start-file-process + "Check direct async `start-file-process'.") + (ert-deftest tramp-test30-make-process () "Check `make-process'." :tags '(:expensive-test) @@ -4408,9 +4429,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (with-timeout (10 (tramp--test-timeout-handler)) (while (< (- (point-max) (point-min)) (length "foo")) (while (accept-process-output proc 0 nil t)))) - ;; We cannot use `string-equal', because tramp-adb.el - ;; echoes also the sent string. - (should (string-match "\\`foo" (buffer-string)))) + (should (string-match "foo" (buffer-string)))) ;; Cleanup. (ignore-errors (delete-process proc))) @@ -4431,7 +4450,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (with-timeout (10 (tramp--test-timeout-handler)) (while (< (- (point-max) (point-min)) (length "foo")) (while (accept-process-output proc 0 nil t)))) - (should (string-equal (buffer-string) "foo"))) + (should (string-match "foo" (buffer-string)))) ;; Cleanup. (ignore-errors @@ -4457,9 +4476,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (with-timeout (10 (tramp--test-timeout-handler)) (while (not (string-match "foo" (buffer-string))) (while (accept-process-output proc 0 nil t)))) - ;; We cannot use `string-equal', because tramp-adb.el - ;; echoes also the sent string. - (should (string-match "\\`foo" (buffer-string)))) + (should (string-match "foo" (buffer-string)))) ;; Cleanup. (ignore-errors (delete-process proc))) @@ -4483,10 +4500,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Read output. (with-timeout (10 (tramp--test-timeout-handler)) (while (accept-process-output proc 0 nil t))) - ;; We cannot use `string-equal', because tramp-adb.el - ;; echoes also the sent string. And a remote macOS sends - ;; a slightly modified string. On MS Windows, - ;; `delete-process' sends an unknown signal. (should (string-match (if (eq system-type 'windows-nt) @@ -4497,55 +4510,60 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (ignore-errors (delete-process proc))) ;; Process with stderr buffer. - (let ((stderr (generate-new-buffer "*stderr*"))) - (unwind-protect - (with-temp-buffer - (setq proc - (with-no-warnings - (make-process - :name "test5" :buffer (current-buffer) - :command '("cat" "/does-not-exist") - :stderr stderr - :file-handler t))) - (should (processp proc)) - ;; Read stderr. - (with-timeout (10 (tramp--test-timeout-handler)) - (while (accept-process-output proc 0 nil t))) - (delete-process proc) - (with-current-buffer stderr - (should - (string-match - "cat:.* No such file or directory" (buffer-string))))) + (unless (tramp-direct-async-process-p) + (let ((stderr (generate-new-buffer "*stderr*"))) + (unwind-protect + (with-temp-buffer + (setq proc + (with-no-warnings + (make-process + :name "test5" :buffer (current-buffer) + :command '("cat" "/does-not-exist") + :stderr stderr + :file-handler t))) + (should (processp proc)) + ;; Read stderr. + (with-timeout (10 (tramp--test-timeout-handler)) + (while (accept-process-output proc 0 nil t))) + (delete-process proc) + (with-current-buffer stderr + (should + (string-match + "cat:.* No such file or directory" (buffer-string))))) - ;; Cleanup. - (ignore-errors (delete-process proc)) - (ignore-errors (kill-buffer stderr)))) + ;; Cleanup. + (ignore-errors (delete-process proc)) + (ignore-errors (kill-buffer stderr))))) ;; Process with stderr file. - (dolist (tmpfile `(,tmp-name1 ,tmp-name2)) - (unwind-protect - (with-temp-buffer - (setq proc - (with-no-warnings - (make-process - :name "test6" :buffer (current-buffer) - :command '("cat" "/does-not-exist") - :stderr tmpfile - :file-handler t))) - (should (processp proc)) - ;; Read stderr. - (with-timeout (10 (tramp--test-timeout-handler)) - (while (accept-process-output proc nil nil t))) - (delete-process proc) + (unless (tramp-direct-async-process-p) + (dolist (tmpfile `(,tmp-name1 ,tmp-name2)) + (unwind-protect (with-temp-buffer - (insert-file-contents tmpfile) - (should - (string-match - "cat:.* No such file or directory" (buffer-string))))) + (setq proc + (with-no-warnings + (make-process + :name "test6" :buffer (current-buffer) + :command '("cat" "/does-not-exist") + :stderr tmpfile + :file-handler t))) + (should (processp proc)) + ;; Read stderr. + (with-timeout (10 (tramp--test-timeout-handler)) + (while (accept-process-output proc nil nil t))) + (delete-process proc) + (with-temp-buffer + (insert-file-contents tmpfile) + (should + (string-match + "cat:.* No such file or directory" (buffer-string))))) - ;; Cleanup. - (ignore-errors (delete-process proc)) - (ignore-errors (delete-file tmpfile))))))) + ;; Cleanup. + (ignore-errors (delete-process proc)) + (ignore-errors (delete-file tmpfile)))))))) + +(tramp--test--deftest-direct-async-process tramp-test30-make-process + "Check direct async `make-process'.") (ert-deftest tramp-test31-interrupt-process () "Check `interrupt-process'."