mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-22 07:09:54 +00:00
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) <adb>: 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'.
This commit is contained in:
Michael Albinus
parent
b8b25400d5
commit
83b1db043b
@ -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
|
||||
|
||||
|
||||
@ -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)))
|
||||
"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))
|
||||
(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)
|
||||
(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))))
|
||||
(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"))))))))
|
||||
;; 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.
|
||||
|
||||
@ -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)))
|
||||
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) </dev/tty\n%s"
|
||||
program (car args) tramp-end-of-heredoc)
|
||||
(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)
|
||||
;; We do not want to raise an error when `make-process'
|
||||
;; has been started several times in `eshell' and
|
||||
;; friends.
|
||||
tramp-current-connection
|
||||
p)
|
||||
(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) </dev/tty\n%s"
|
||||
program (car args) tramp-end-of-heredoc)
|
||||
(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)
|
||||
;; 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)
|
||||
(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)
|
||||
(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))
|
||||
(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."
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -64,6 +64,11 @@ protect against "make" variable expansion):
|
||||
|
||||
make <filename> SELECTOR='"foo$$"'
|
||||
|
||||
In case you want to use the symbol name of a test as selector, you can
|
||||
use it directly:
|
||||
|
||||
make <filename> 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
|
||||
|
||||
@ -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."
|
||||
|
||||
Loading…
Reference in New Issue
Block a user