From 83b1db043b44a8efb091ced873eab686e671c5ac Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 4 Aug 2020 14:19:51 +0200 Subject: [PATCH] Add Tramp support of direct asynchronous process invocation * doc/misc/tramp.texi (Predefined connection information): Add "direct-async-process". (Remote processes): New subsection "Improving performance of asynchronous remote processes". * lisp/net/tramp-adb.el (tramp-methods) : Add `tramp-login-program' and `tramp-login-args'. (tramp-adb-handle-make-process): Use `tramp-handle-make-process'. (tramp-adb-maybe-open-connection): Add "set +o vi +o emacs" command. * lisp/net/tramp-sh.el (tramp-sh-handle-make-process): Use `tramp-handle-make-process'. (tramp-sh-file-name-handler-p, tramp-multi-hop-p): New defuns. (tramp-compute-multi-hops): Use `tramp-multi-hop-p'. * lisp/net/tramp.el (tramp-dissect-file-name, tramp-dissect-hop-name): Use `tramp-multi-hop-p'. (tramp-handle-insert-file-contents, tramp-local-host-p): Use `tramp-sh-file-name-handler-p'. (tramp-handle-make-process): New defun. * test/README: Add another example how to use SELECTOR. * test/lisp/net/tramp-tests.el (tramp-test03-file-name-method-rules): Adapt test. (tramp--test-sh-p): Use `tramp-sh-file-name-handler-p'. --- doc/misc/tramp.texi | 83 ++++++- lisp/net/tramp-adb.el | 323 ++++++++++++------------ lisp/net/tramp-sh.el | 462 ++++++++++++++++++----------------- lisp/net/tramp.el | 165 ++++++++++++- test/README | 5 + test/lisp/net/tramp-tests.el | 18 +- 6 files changed, 651 insertions(+), 405 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index b4195111d4a..91b1e996f45 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -2053,6 +2053,13 @@ The temporary directory on the remote host. If not specified, the default value is @t{"/data/local/tmp"} for the @option{adb} method, @t{"/C$/Temp"} for the @option{smb} method, and @t{"/tmp"} otherwise. +@item @t{"direct-async-process"} + +When this property is non-@code{nil}, an alternative, more performant +implementation of @code{make-process} and +@code{start-file-process} is applied. @ref{Improving performance of +asynchronous remote processes} for a discussion of constraints. + @item @t{"posix"} Connections using the @option{smb} method check, whether the remote @@ -2458,10 +2465,9 @@ overwrite as follows: @lisp @group -(add-to-list - 'tramp-connection-properties - `(,(regexp-quote "192.168.0.1") - "remote-copy-args" (("-l") ("%r")))) +(add-to-list 'tramp-connection-properties + `(,(regexp-quote "192.168.0.1") + "remote-copy-args" (("-l") ("%r")))) @end group @end lisp @@ -3527,6 +3533,70 @@ To open @command{powershell} as a remote shell, use this: @end lisp +@anchor{Improving performance of asynchronous remote processes} +@subsection Improving performance of asynchronous remote processes +@cindex Asynchronous remote processes +@findex make-process +@findex start-file-process + +@value{tramp}'s implementation of @code{make-process} and +@code{start-file-process} requires a serious overhead for +initialization, every process invocation. This is needed for handling +interactive dialogues when connecting the remote host (like providing +a password), and initial environment setup. + +Sometimes, this is not needed. Instead of starting a remote shell and +running the command afterwards, it is sufficient to run the command +directly. @value{tramp} supports this by an alternative +implementation of @code{make-process} and @code{start-file-process}. +This is triggered by the connection property +@t{"direct-async-process"}, @xref{Predefined connection information}, +which must be set to a non-@code{nil} value. Example: + +@lisp +@group +(add-to-list 'tramp-connection-properties + (list (regexp-quote "@trampfn{ssh,user@@host,}") + "direct-async-process" t)) +@end group +@end lisp + +However, this approach has different limitations: + +@itemize +@item +It works only for connection methods defined in @file{tramp-sh.el} and +@file{tramp-adb.el}. + +@item +It does not support multi-hop methods. + +@item +It does not support interactive user authentication, like password +handling. + +@item +It does not support a separated error stream. + +@item +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 use @code{tramp-remote-path} and +@code{tramp-remote-process-environment}. + +@item +It does not set environment variable @env{INSIDE_EMACS}. +@end itemize + +In order to gain even more performance, it is recommended to bind +@code{tramp-verbose} to 0 when running @code{make-process} or +@code{start-file-process}. + + @node Cleanup remote connections @section Cleanup remote connections @cindex cleanup @@ -4555,9 +4625,8 @@ Abbreviation list expansion can be used to reduce typing long file names: @lisp @group -(add-to-list - 'directory-abbrev-alist - '("^/xy" . "@trampfn{ssh,news@@news.my.domain,/opt/news/etc/}")) +(add-to-list 'directory-abbrev-alist + '("^/xy" . "@trampfn{ssh,news@@news.my.domain,/opt/news/etc/}")) @end group @end lisp diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 7e5af6910bb..88f5c2928e3 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -96,8 +96,10 @@ It is used for TCP/IP devices." (tramp--with-startup (add-to-list 'tramp-methods `(,tramp-adb-method - (tramp-tmpdir "/data/local/tmp") - (tramp-default-port 5555))) + (tramp-login-program ,tramp-adb-program) + (tramp-login-args (("shell"))) + (tramp-tmpdir "/data/local/tmp") + (tramp-default-port 5555))) (add-to-list 'tramp-default-host-alist `(,tramp-adb-method nil "")) @@ -885,158 +887,163 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; The complete STDERR buffer is available only when the process has ;; terminated. (defun tramp-adb-handle-make-process (&rest args) - "Like `make-process' for Tramp files." - (when args - (with-parsed-tramp-file-name (expand-file-name default-directory) nil - (let ((name (plist-get args :name)) - (buffer (plist-get args :buffer)) - (command (plist-get args :command)) - (coding (plist-get args :coding)) - (noquery (plist-get args :noquery)) - (connection-type (plist-get args :connection-type)) - (filter (plist-get args :filter)) - (sentinel (plist-get args :sentinel)) - (stderr (plist-get args :stderr))) - (unless (stringp name) - (signal 'wrong-type-argument (list #'stringp name))) - (unless (or (null buffer) (bufferp buffer) (stringp buffer)) - (signal 'wrong-type-argument (list #'stringp buffer))) - (unless (consp command) - (signal 'wrong-type-argument (list #'consp command))) - (unless (or (null coding) - (and (symbolp coding) (memq coding coding-system-list)) - (and (consp coding) - (memq (car coding) coding-system-list) - (memq (cdr coding) coding-system-list))) - (signal 'wrong-type-argument (list #'symbolp coding))) - (unless (or (null connection-type) (memq connection-type '(pipe pty))) - (signal 'wrong-type-argument (list #'symbolp connection-type))) - (unless (or (null filter) (functionp filter)) - (signal 'wrong-type-argument (list #'functionp filter))) - (unless (or (null sentinel) (functionp sentinel)) - (signal 'wrong-type-argument (list #'functionp sentinel))) - (unless (or (null stderr) (bufferp stderr) (stringp stderr)) - (signal 'wrong-type-argument (list #'stringp stderr))) - (when (and (stringp stderr) (tramp-tramp-file-p stderr) - (not (tramp-equal-remote default-directory stderr))) - (signal 'file-error (list "Wrong stderr" 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))) - ;; STDERR can also be a file name. - (tmpstderr - (and stderr - (if (and (stringp stderr) (tramp-tramp-file-p stderr)) - (tramp-unquote-file-local-name stderr) - (tramp-make-tramp-temp-file v)))) - (remote-tmpstderr - (and tmpstderr (tramp-make-tramp-file-name v tmpstderr))) - (program (car command)) - (args (cdr command)) - (command - (format "cd %s && exec %s %s" - (tramp-shell-quote-argument localname) - (if tmpstderr (format "2>'%s'" tmpstderr) "") - (mapconcat #'tramp-shell-quote-argument - (cons program args) " "))) - (tramp-process-connection-type - (or (null program) tramp-process-connection-type)) - (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer))) - (name1 name) - (i 0)) - - (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) - - (with-current-buffer (tramp-get-connection-buffer v) - (unwind-protect - ;; We catch this event. Otherwise, `make-process' - ;; could be called on the local host. - (save-excursion - (save-restriction - ;; Activate narrowing in order to save BUFFER - ;; contents. Clear also the modification time; - ;; otherwise we might be interrupted by - ;; `verify-visited-file-modtime'. - (let ((buffer-undo-list t) - (inhibit-read-only t)) - (clear-visited-file-modtime) - (narrow-to-region (point-max) (point-max)) - ;; We call `tramp-adb-maybe-open-connection', in - ;; order to cleanup the prompt afterwards. - (tramp-adb-maybe-open-connection v) - (delete-region (point-min) (point-max)) - ;; Send the command. - (let* ((p (tramp-get-connection-process v))) - (tramp-adb-send-command v command nil t) ; nooutput - ;; 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") - ;; Copy tmpstderr file. - (when (and (stringp stderr) - (not (tramp-tramp-file-p stderr))) - (add-function - :after (process-sentinel p) - (lambda (_proc _msg) - (rename-file remote-tmpstderr stderr)))) - ;; Read initial output. Remove the first line, - ;; which is the command echo. - (while - (progn - (goto-char (point-min)) - (not (re-search-forward "[\n]" nil t))) - (tramp-accept-process-output p 0)) - (delete-region (point-min) (point)) - ;; Provide error buffer. This shows only - ;; initial error messages; messages arriving - ;; later on will be inserted when the process - ;; is deleted. The temporary file will exist - ;; until the process is deleted. - (when (bufferp stderr) - (with-current-buffer stderr - (insert-file-contents-literally - remote-tmpstderr 'visit)) - ;; Delete tmpstderr file. - (add-function - :after (process-sentinel p) - (lambda (_proc _msg) - (with-current-buffer stderr - (insert-file-contents-literally - remote-tmpstderr 'visit nil nil 'replace)) - (delete-file remote-tmpstderr)))) - ;; Return process. - p)))) - - ;; Save exit. - (if (string-match-p tramp-temp-buffer-name (buffer-name)) - (ignore-errors - (set-process-buffer (tramp-get-connection-process v) nil) - (kill-buffer (current-buffer))) - (set-buffer-modified-p bmp)) - (tramp-flush-connection-property v "process-name") - (tramp-flush-connection-property v "process-buffer")))))))) + "Like `make-process' for Tramp files. +If connection property \"direct-async-process\" is non-nil, an +alternative implementation will be used." + (if (tramp-get-connection-property + (tramp-dissect-file-name default-directory) "direct-async-process" nil) + (apply #'tramp-handle-make-process args) + (when args + (with-parsed-tramp-file-name (expand-file-name default-directory) nil + (let ((name (plist-get args :name)) + (buffer (plist-get args :buffer)) + (command (plist-get args :command)) + (coding (plist-get args :coding)) + (noquery (plist-get args :noquery)) + (connection-type (plist-get args :connection-type)) + (filter (plist-get args :filter)) + (sentinel (plist-get args :sentinel)) + (stderr (plist-get args :stderr))) + (unless (stringp name) + (signal 'wrong-type-argument (list #'stringp name))) + (unless (or (null buffer) (bufferp buffer) (stringp buffer)) + (signal 'wrong-type-argument (list #'stringp buffer))) + (unless (consp command) + (signal 'wrong-type-argument (list #'consp command))) + (unless (or (null coding) + (and (symbolp coding) (memq coding coding-system-list)) + (and (consp coding) + (memq (car coding) coding-system-list) + (memq (cdr coding) coding-system-list))) + (signal 'wrong-type-argument (list #'symbolp coding))) + (unless (or (null connection-type) (memq connection-type '(pipe pty))) + (signal 'wrong-type-argument (list #'symbolp connection-type))) + (unless (or (null filter) (functionp filter)) + (signal 'wrong-type-argument (list #'functionp filter))) + (unless (or (null sentinel) (functionp sentinel)) + (signal 'wrong-type-argument (list #'functionp sentinel))) + (unless (or (null stderr) (bufferp stderr) (stringp stderr)) + (signal 'wrong-type-argument (list #'stringp stderr))) + (when (and (stringp stderr) (tramp-tramp-file-p stderr) + (not (tramp-equal-remote default-directory stderr))) + (signal 'file-error (list "Wrong stderr" 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))) + ;; STDERR can also be a file name. + (tmpstderr + (and stderr + (if (and (stringp stderr) (tramp-tramp-file-p stderr)) + (tramp-unquote-file-local-name stderr) + (tramp-make-tramp-temp-file v)))) + (remote-tmpstderr + (and tmpstderr (tramp-make-tramp-file-name v tmpstderr))) + (program (car command)) + (args (cdr command)) + (command + (format "cd %s && exec %s %s" + (tramp-shell-quote-argument localname) + (if tmpstderr (format "2>'%s'" tmpstderr) "") + (mapconcat #'tramp-shell-quote-argument + (cons program args) " "))) + (tramp-process-connection-type + (or (null program) tramp-process-connection-type)) + (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer))) + (name1 name) + (i 0)) + + (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) + + (with-current-buffer (tramp-get-connection-buffer v) + (unwind-protect + ;; We catch this event. Otherwise, `make-process' + ;; could be called on the local host. + (save-excursion + (save-restriction + ;; Activate narrowing in order to save BUFFER + ;; contents. Clear also the modification time; + ;; otherwise we might be interrupted by + ;; `verify-visited-file-modtime'. + (let ((buffer-undo-list t) + (inhibit-read-only t)) + (clear-visited-file-modtime) + (narrow-to-region (point-max) (point-max)) + ;; We call `tramp-adb-maybe-open-connection', + ;; in order to cleanup the prompt afterwards. + (tramp-adb-maybe-open-connection v) + (delete-region (point-min) (point-max)) + ;; Send the command. + (let* ((p (tramp-get-connection-process v))) + (tramp-adb-send-command v command nil t) ; nooutput + ;; 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") + ;; Copy tmpstderr file. + (when (and (stringp stderr) + (not (tramp-tramp-file-p stderr))) + (add-function + :after (process-sentinel p) + (lambda (_proc _msg) + (rename-file remote-tmpstderr stderr)))) + ;; Read initial output. Remove the first + ;; line, which is the command echo. + (while + (progn + (goto-char (point-min)) + (not (re-search-forward "[\n]" nil t))) + (tramp-accept-process-output p 0)) + (delete-region (point-min) (point)) + ;; Provide error buffer. This shows only + ;; initial error messages; messages arriving + ;; later on will be inserted when the + ;; process is deleted. The temporary file + ;; will exist until the process is deleted. + (when (bufferp stderr) + (with-current-buffer stderr + (insert-file-contents-literally + remote-tmpstderr 'visit)) + ;; Delete tmpstderr file. + (add-function + :after (process-sentinel p) + (lambda (_proc _msg) + (with-current-buffer stderr + (insert-file-contents-literally + remote-tmpstderr 'visit nil nil 'replace)) + (delete-file remote-tmpstderr)))) + ;; Return process. + p)))) + + ;; Save exit. + (if (string-match-p tramp-temp-buffer-name (buffer-name)) + (ignore-errors + (set-process-buffer (tramp-get-connection-process v) nil) + (kill-buffer (current-buffer))) + (set-buffer-modified-p bmp)) + (tramp-flush-connection-property v "process-name") + (tramp-flush-connection-property v "process-buffer"))))))))) (defun tramp-adb-handle-exec-path () "Like `exec-path' for Tramp files." @@ -1253,6 +1260,14 @@ connection if a previous connection has died for some reason." (tramp-adb-send-command vec (format "PS1=\"///\"\"%s\"\"#$\"" prompt)) + ;; Disable line editing. + (tramp-adb-send-command + vec "set +o vi +o vi-esccomplete +o vi-tabcomplete +o emacs") + + ;; Dump option settings in the traces. + (when (>= tramp-verbose 9) + (tramp-adb-send-command vec "set -o")) + ;; Check whether the properties have been changed. If ;; yes, this is a strong indication that we must expire all ;; connection properties. We start again. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index f9f0cbcc023..3e2eb023a33 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2787,228 +2787,233 @@ the result will be a local, non-Tramp, file name." ;; terminated. (defun tramp-sh-handle-make-process (&rest args) "Like `make-process' for Tramp files. -STDERR can also be a file name." - (when args - (with-parsed-tramp-file-name (expand-file-name default-directory) nil - (let ((name (plist-get args :name)) - (buffer (plist-get args :buffer)) - (command (plist-get args :command)) - (coding (plist-get args :coding)) - (noquery (plist-get args :noquery)) - (connection-type (plist-get args :connection-type)) - (filter (plist-get args :filter)) - (sentinel (plist-get args :sentinel)) - (stderr (plist-get args :stderr))) - (unless (stringp name) - (signal 'wrong-type-argument (list #'stringp name))) - (unless (or (null buffer) (bufferp buffer) (stringp buffer)) - (signal 'wrong-type-argument (list #'stringp buffer))) - (unless (consp command) - (signal 'wrong-type-argument (list #'consp command))) - (unless (or (null coding) - (and (symbolp coding) (memq coding coding-system-list)) - (and (consp coding) - (memq (car coding) coding-system-list) - (memq (cdr coding) coding-system-list))) - (signal 'wrong-type-argument (list #'symbolp coding))) - (unless (or (null connection-type) (memq connection-type '(pipe pty))) - (signal 'wrong-type-argument (list #'symbolp connection-type))) - (unless (or (null filter) (functionp filter)) - (signal 'wrong-type-argument (list #'functionp filter))) - (unless (or (null sentinel) (functionp sentinel)) - (signal 'wrong-type-argument (list #'functionp sentinel))) - (unless (or (null stderr) (bufferp stderr) (stringp stderr)) - (signal 'wrong-type-argument (list #'stringp stderr))) - (when (and (stringp stderr) (tramp-tramp-file-p stderr) - (not (tramp-equal-remote default-directory stderr))) - (signal 'file-error (list "Wrong stderr" 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))) - ;; STDERR can also be a file name. - (tmpstderr - (and stderr - (if (and (stringp stderr) (tramp-tramp-file-p stderr)) - (tramp-unquote-file-local-name stderr) - (tramp-make-tramp-temp-file v)))) - (remote-tmpstderr - (and tmpstderr (tramp-make-tramp-file-name v tmpstderr))) - (program (car command)) - (args (cdr command)) - ;; When PROGRAM matches "*sh", and the first arg is - ;; "-c", it might be that the arguments exceed the - ;; command line length. Therefore, we modify the - ;; command. - (heredoc (and (stringp program) - (string-match-p "sh$" program) - (string-equal "-c" (car args)) - (= (length args) 2))) - ;; When PROGRAM is nil, we just provide a tty. - (args (if (not heredoc) args - (let ((i 250)) - (while (and (< i (length (cadr args))) - (string-match " " (cadr args) i)) - (setcdr - args - (list - (replace-match " \\\\\n" nil nil (cadr args)))) - (setq i (+ i 250)))) - (cdr args))) - ;; Use a human-friendly prompt, for example for - ;; `shell'. We discard hops, if existing, that's why - ;; we cannot use `file-remote-p'. - (prompt (format "PS1=%s %s" - (tramp-make-tramp-file-name v nil 'nohop) - tramp-initial-end-of-output)) - ;; We use as environment the difference to toplevel - ;; `process-environment'. - env uenv - (env (dolist (elt (cons prompt process-environment) env) - (or (member - elt (default-toplevel-value 'process-environment)) - (if (string-match-p "=" elt) - (setq env (append env `(,elt))) - (if (tramp-get-env-with-u-option v) - (setq env (append `("-u" ,elt) env)) - (setq uenv (cons elt uenv))))))) - (command - (when (stringp program) - (setenv-internal - env "INSIDE_EMACS" - (concat (or (getenv "INSIDE_EMACS") emacs-version) - ",tramp:" tramp-version) - 'keep) - (format "cd %s && %s exec %s %s env %s %s" - (tramp-shell-quote-argument localname) - (if uenv - (format - "unset %s &&" - (mapconcat - #'tramp-shell-quote-argument uenv " ")) - "") - (if heredoc (format "<<'%s'" tramp-end-of-heredoc) "") - (if tmpstderr (format "2>'%s'" tmpstderr) "") - (mapconcat #'tramp-shell-quote-argument env " ") - (if heredoc - (format "%s\n(\n%s\n) " 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) - - (with-current-buffer (tramp-get-connection-buffer v) - (unwind-protect - ;; We catch this event. Otherwise, `make-process' could - ;; be called on the local host. - (save-excursion - (save-restriction - ;; Activate narrowing in order to save BUFFER - ;; contents. Clear also the modification time; - ;; otherwise we might be interrupted by - ;; `verify-visited-file-modtime'. - (let ((buffer-undo-list t) - (inhibit-read-only t) - (mark (point-max))) - (clear-visited-file-modtime) - (narrow-to-region (point-max) (point-max)) - ;; We call `tramp-maybe-open-connection', in - ;; order to cleanup the prompt afterwards. - (catch 'suppress - (tramp-maybe-open-connection v) - (setq p (tramp-get-connection-process v)) - ;; Set the pid of the remote shell. This is - ;; needed when sending signals remotely. - (let ((pid (tramp-send-command-and-read v "echo $$"))) - (process-put p 'remote-pid pid) - (tramp-set-connection-property p "remote-pid" pid)) - ;; `tramp-maybe-open-connection' and - ;; `tramp-send-command-and-read' could have - ;; trashed the connection buffer. Remove this. - (widen) - (delete-region mark (point-max)) +STDERR can also be a file name. If connection property +\"direct-async-process\" is non-nil, an alternative +implementation will be used." + (if (tramp-get-connection-property + (tramp-dissect-file-name default-directory) "direct-async-process" nil) + (apply #'tramp-handle-make-process args) + (when args + (with-parsed-tramp-file-name (expand-file-name default-directory) nil + (let ((name (plist-get args :name)) + (buffer (plist-get args :buffer)) + (command (plist-get args :command)) + (coding (plist-get args :coding)) + (noquery (plist-get args :noquery)) + (connection-type (plist-get args :connection-type)) + (filter (plist-get args :filter)) + (sentinel (plist-get args :sentinel)) + (stderr (plist-get args :stderr))) + (unless (stringp name) + (signal 'wrong-type-argument (list #'stringp name))) + (unless (or (null buffer) (bufferp buffer) (stringp buffer)) + (signal 'wrong-type-argument (list #'stringp buffer))) + (unless (consp command) + (signal 'wrong-type-argument (list #'consp command))) + (unless (or (null coding) + (and (symbolp coding) (memq coding coding-system-list)) + (and (consp coding) + (memq (car coding) coding-system-list) + (memq (cdr coding) coding-system-list))) + (signal 'wrong-type-argument (list #'symbolp coding))) + (unless (or (null connection-type) (memq connection-type '(pipe pty))) + (signal 'wrong-type-argument (list #'symbolp connection-type))) + (unless (or (null filter) (functionp filter)) + (signal 'wrong-type-argument (list #'functionp filter))) + (unless (or (null sentinel) (functionp sentinel)) + (signal 'wrong-type-argument (list #'functionp sentinel))) + (unless (or (null stderr) (bufferp stderr) (stringp stderr)) + (signal 'wrong-type-argument (list #'stringp stderr))) + (when (and (stringp stderr) (tramp-tramp-file-p stderr) + (not (tramp-equal-remote default-directory stderr))) + (signal 'file-error (list "Wrong stderr" 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))) + ;; STDERR can also be a file name. + (tmpstderr + (and stderr + (if (and (stringp stderr) (tramp-tramp-file-p stderr)) + (tramp-unquote-file-local-name stderr) + (tramp-make-tramp-temp-file v)))) + (remote-tmpstderr + (and tmpstderr (tramp-make-tramp-file-name v tmpstderr))) + (program (car command)) + (args (cdr command)) + ;; When PROGRAM matches "*sh", and the first arg is + ;; "-c", it might be that the arguments exceed the + ;; command line length. Therefore, we modify the + ;; command. + (heredoc (and (stringp program) + (string-match-p "sh$" program) + (string-equal "-c" (car args)) + (= (length args) 2))) + ;; When PROGRAM is nil, we just provide a tty. + (args (if (not heredoc) args + (let ((i 250)) + (while (and (< i (length (cadr args))) + (string-match " " (cadr args) i)) + (setcdr + args + (list + (replace-match " \\\\\n" nil nil (cadr args)))) + (setq i (+ i 250)))) + (cdr args))) + ;; Use a human-friendly prompt, for example for + ;; `shell'. We discard hops, if existing, that's why + ;; we cannot use `file-remote-p'. + (prompt (format "PS1=%s %s" + (tramp-make-tramp-file-name v nil 'nohop) + tramp-initial-end-of-output)) + ;; We use as environment the difference to toplevel + ;; `process-environment'. + env uenv + (env (dolist (elt (cons prompt process-environment) env) + (or (member + elt (default-toplevel-value 'process-environment)) + (if (string-match-p "=" elt) + (setq env (append env `(,elt))) + (if (tramp-get-env-with-u-option v) + (setq env (append `("-u" ,elt) env)) + (setq uenv (cons elt uenv))))))) + (command + (when (stringp program) + (setenv-internal + env "INSIDE_EMACS" + (concat (or (getenv "INSIDE_EMACS") emacs-version) + ",tramp:" tramp-version) + 'keep) + (format "cd %s && %s exec %s %s env %s %s" + (tramp-shell-quote-argument localname) + (if uenv + (format + "unset %s &&" + (mapconcat + #'tramp-shell-quote-argument uenv " ")) + "") + (if heredoc (format "<<'%s'" tramp-end-of-heredoc) "") + (if tmpstderr (format "2>'%s'" tmpstderr) "") + (mapconcat #'tramp-shell-quote-argument env " ") + (if heredoc + (format "%s\n(\n%s\n) " 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) + + (with-current-buffer (tramp-get-connection-buffer v) + (unwind-protect + ;; We catch this event. Otherwise, `make-process' + ;; could be called on the local host. + (save-excursion + (save-restriction + ;; Activate narrowing in order to save BUFFER + ;; contents. Clear also the modification time; + ;; otherwise we might be interrupted by + ;; `verify-visited-file-modtime'. + (let ((buffer-undo-list t) + (inhibit-read-only t) + (mark (point-max))) + (clear-visited-file-modtime) (narrow-to-region (point-max) (point-max)) - ;; Now do it. - (if command - ;; Send the command. - (tramp-send-command v command nil t) ; nooutput - ;; Check, whether a pty is associated. - (unless (process-get p 'remote-tty) - (tramp-error - v 'file-error - "pty association is not supported for `%s'" - name)))) - ;; 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") - ;; Copy tmpstderr file. - (when (and (stringp stderr) - (not (tramp-tramp-file-p stderr))) - (add-function - :after (process-sentinel p) - (lambda (_proc _msg) - (rename-file remote-tmpstderr stderr)))) - ;; Provide error buffer. This shows only - ;; initial error messages; messages arriving - ;; later on will be inserted when the process is - ;; deleted. The temporary file will exist until - ;; the process is deleted. - (when (bufferp stderr) - (with-current-buffer stderr - (insert-file-contents-literally remote-tmpstderr)) - ;; Delete tmpstderr file. - (add-function - :after (process-sentinel p) - (lambda (_proc _msg) - (when (file-exists-p remote-tmpstderr) - (with-current-buffer stderr - (insert-file-contents-literally - remote-tmpstderr nil nil nil 'replace)) - (delete-file remote-tmpstderr))))) - ;; Return process. - p))) + ;; We call `tramp-maybe-open-connection', in + ;; order to cleanup the prompt afterwards. + (catch 'suppress + (tramp-maybe-open-connection v) + (setq p (tramp-get-connection-process v)) + ;; Set the pid of the remote shell. This is + ;; needed when sending signals remotely. + (let ((pid (tramp-send-command-and-read v "echo $$"))) + (process-put p 'remote-pid pid) + (tramp-set-connection-property p "remote-pid" pid)) + ;; `tramp-maybe-open-connection' and + ;; `tramp-send-command-and-read' could have + ;; trashed the connection buffer. Remove this. + (widen) + (delete-region mark (point-max)) + (narrow-to-region (point-max) (point-max)) + ;; Now do it. + (if command + ;; Send the command. + (tramp-send-command v command nil t) ; nooutput + ;; Check, whether a pty is associated. + (unless (process-get p 'remote-tty) + (tramp-error + v 'file-error + "pty association is not supported for `%s'" + name)))) + ;; 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") + ;; Copy tmpstderr file. + (when (and (stringp stderr) + (not (tramp-tramp-file-p stderr))) + (add-function + :after (process-sentinel p) + (lambda (_proc _msg) + (rename-file remote-tmpstderr stderr)))) + ;; Provide error buffer. This shows only + ;; initial error messages; messages arriving + ;; later on will be inserted when the process + ;; is deleted. The temporary file will exist + ;; until the process is deleted. + (when (bufferp stderr) + (with-current-buffer stderr + (insert-file-contents-literally remote-tmpstderr)) + ;; Delete tmpstderr file. + (add-function + :after (process-sentinel p) + (lambda (_proc _msg) + (when (file-exists-p remote-tmpstderr) + (with-current-buffer stderr + (insert-file-contents-literally + remote-tmpstderr nil nil nil 'replace)) + (delete-file remote-tmpstderr))))) + ;; 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")))))))) + ;; 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"))))))))) (defun tramp-sh-get-signal-strings (vec) "Strings to return by `process-file' in case of signals." @@ -3646,6 +3651,14 @@ Fall back to normal file name handler if no Tramp handler exists." (save-match-data (apply (cdr fn) args)) (tramp-run-real-handler operation args))) +;;;###tramp-autoload +(defun tramp-sh-file-name-handler-p (vec) + "Whether VEC uses a method from `tramp-sh-file-name-handler'." + (and (assoc (tramp-file-name-method vec) tramp-methods) + (eq (tramp-find-foreign-file-name-handler + (tramp-make-tramp-file-name vec nil 'nohop)) + 'tramp-sh-file-name-handler))) + ;; This must be the last entry, because `identity' always matches. ;;;###tramp-autoload (tramp--with-startup @@ -4769,6 +4782,12 @@ 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) @@ -4832,8 +4851,7 @@ Goes through the list `tramp-inline-compress-commands'." (when (cdr target-alist) (setq choices target-alist) (while (setq item (pop choices)) - (when (or (not (tramp-get-method-parameter item 'tramp-login-program)) - (tramp-get-method-parameter item 'tramp-copy-program)) + (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." diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index c169a86f915..d1b2935a3c6 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1482,10 +1482,7 @@ default values are used." (tramp-user-error v "Method `%s' is not known." method)) ;; Only some methods from tramp-sh.el do support multi-hops. - (when (and - hop - (or (not (tramp-get-method-parameter v 'tramp-login-program)) - (tramp-get-method-parameter v 'tramp-copy-program))) + (unless (or (null hop) nodefault non-essential (tramp-multi-hop-p v)) (tramp-user-error v "Method `%s' is not supported for multi-hops." method))))))) @@ -1499,8 +1496,7 @@ See `tramp-dissect-file-name' for details." tramp-postfix-host-format name)) nodefault))) ;; Only some methods from tramp-sh.el do support multi-hops. - (when (or (not (tramp-get-method-parameter v 'tramp-login-program)) - (tramp-get-method-parameter v 'tramp-copy-program)) + (unless (or nodefault non-essential (tramp-multi-hop-p v)) (tramp-user-error v "Method `%s' is not supported for multi-hops." (tramp-file-name-method v))) @@ -3519,13 +3515,10 @@ User is always nil." ;; When we shall insert only a part of the file, we ;; copy this part. This works only for the shell file - ;; name handlers. + ;; name handlers. It doesn't work for crypted files. (when (and (or beg end) - ;; Direct actions aren't possible for - ;; crypted directories. - (null tramp-crypt-enabled) - (tramp-get-method-parameter - v 'tramp-login-program)) + (tramp-sh-file-name-handler-p v) + (null tramp-crypt-enabled)) (setq remote-copy (tramp-make-tramp-temp-file v)) ;; This is defined in tramp-sh.el. Let's assume ;; this is loaded already. @@ -3640,6 +3633,152 @@ User is always nil." (load local-copy noerror t nosuffix must-suffix) (delete-file local-copy))))) t))) +;; 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. +(defun tramp-handle-make-process (&rest args) + "An alternative `make-process' implementation for Tramp files." + (when args + (with-parsed-tramp-file-name (expand-file-name default-directory) nil + (let ((name (plist-get args :name)) + (buffer (plist-get args :buffer)) + (command (plist-get args :command)) + (coding (plist-get args :coding)) + (noquery (plist-get args :noquery)) + (connection-type (plist-get args :connection-type)) + (filter (plist-get args :filter)) + (sentinel (plist-get args :sentinel)) + (stderr (plist-get args :stderr))) + (unless (stringp name) + (signal 'wrong-type-argument (list #'stringp name))) + (unless (or (null buffer) (bufferp buffer) (stringp buffer)) + (signal 'wrong-type-argument (list #'stringp buffer))) + (unless (consp command) + (signal 'wrong-type-argument (list #'consp command))) + (unless (or (null coding) + (and (symbolp coding) (memq coding coding-system-list)) + (and (consp coding) + (memq (car coding) coding-system-list) + (memq (cdr coding) coding-system-list))) + (signal 'wrong-type-argument (list #'symbolp coding))) + (unless (or (null connection-type) (memq connection-type '(pipe pty))) + (signal 'wrong-type-argument (list #'symbolp connection-type))) + (unless (or (null filter) (functionp filter)) + (signal 'wrong-type-argument (list #'functionp filter))) + (unless (or (null sentinel) (functionp sentinel)) + (signal 'wrong-type-argument (list #'functionp sentinel))) + (unless (or (null stderr) (bufferp stderr) (stringp stderr)) + (signal 'wrong-type-argument (list #'stringp stderr))) + (when (and (stringp stderr) (tramp-tramp-file-p stderr) + (not (tramp-equal-remote default-directory stderr))) + (signal 'file-error (list "Wrong stderr" 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) + + (with-current-buffer (tramp-get-connection-buffer v) + (unwind-protect + (let* ((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 (tramp-sh-file-name-handler-p v) + (with-tramp-connection-property + (tramp-get-process v) "temp-file" + (tramp-compat-make-temp-name)))) + (options + (when (tramp-sh-file-name-handler-p v) + (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")))))))) (defun tramp-handle-make-symbolic-link (target linkname &optional ok-if-already-exists) @@ -4706,7 +4845,7 @@ This handles also chrooted environments, which are not regarded as local." ;; The method shall be applied to one of the shell file name ;; handlers. `tramp-local-host-p' is also called for "smb" and ;; alike, where it must fail. - (tramp-get-method-parameter vec 'tramp-login-program) + (tramp-sh-file-name-handler-p vec) ;; Direct actions aren't possible for crypted directories. (null tramp-crypt-enabled) ;; The local temp directory must be writable for the other user. diff --git a/test/README b/test/README index 1f69f7142c1..fe05b5403b1 100644 --- a/test/README +++ b/test/README @@ -64,6 +64,11 @@ protect against "make" variable expansion): make SELECTOR='"foo$$"' +In case you want to use the symbol name of a test as selector, you can +use it directly: + + make SELECTOR='test-foo-remote' + Note that although the test files are always compiled (unless they set no-byte-compile), the source files will be run when expensive or unstable tests are involved, to give nicer backtraces. To run the diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index ac24fcf280a..05196e7e4a6 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2001,12 +2001,13 @@ is greater than 10. (skip-unless (tramp--test-enabled)) ;; Multi hops are allowed for inline methods only. - (should-error - (file-remote-p "/ssh:user1@host1|method:user2@host2:/path/to/file") - :type 'user-error) - (should-error - (file-remote-p "/method:user1@host1|ssh:user2@host2:/path/to/file") - :type 'user-error) + (let (non-essential) + (should-error + (expand-file-name "/ssh:user1@host1|method:user2@host2:/path/to/file") + :type 'user-error) + (should-error + (expand-file-name "/method:user1@host1|ssh:user2@host2:/path/to/file") + :type 'user-error)) ;; Samba does not support file names with periods followed by ;; spaces, and trailing periods or spaces. @@ -5681,9 +5682,8 @@ This does not support special file names." (defun tramp--test-sh-p () "Check, whether the remote host runs a based method from tramp-sh.el." - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler)) + (tramp-sh-file-name-handler-p + (tramp-dissect-file-name tramp-test-temporary-file-directory))) (defun tramp--test-sudoedit-p () "Check, whether the sudoedit method is used." -- 2.39.2