Function: tramp-sh-handle-make-process
tramp-sh-handle-make-process is a byte-compiled function defined in
tramp-sh.el.gz.
Signature
(tramp-sh-handle-make-process &rest ARGS)
Documentation
Like make-process for Tramp files.
STDERR can also be a remote file name. If method parameter
tramp-direct-async and connection-local variable
tramp-direct-async-process are non-nil, an alternative implementation
will be used.
Source Code
;; Defined in /usr/src/emacs/lisp/net/tramp-sh.el.gz
;; 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-sh-handle-make-process (&rest args)
"Like `make-process' for Tramp files.
STDERR can also be a remote file name. If method parameter
`tramp-direct-async' and connection-local variable
`tramp-direct-async-process' are non-nil, an alternative implementation
will be used."
(if (tramp-direct-async-process-p args)
(apply #'tramp-handle-make-process args)
(tramp-skeleton-make-process args t t
(let* ((program (car command))
(args (cdr command))
;; STDERR can also be a file name.
(tmpstderr
(and stderr
(tramp-unquote-file-local-name
(if (stringp stderr)
stderr (tramp-make-tramp-temp-name v)))))
(remote-tmpstderr
(and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
;; 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 (not (bufferp stderr))
(stringp program)
(string-match-p (rx "sh" eol) program)
(length= args 2)
(string-equal "-c" (car args))
;; Don't if there is a quoted string.
(not (string-match-p (rx (any "'\"")) (cadr args)))
;; Check, that /dev/tty is usable.
(tramp-get-remote-dev-tty v)))
;; When PROGRAM is nil, we just provide a tty.
(args (if (not heredoc) args
(let ((i 250))
(while (and (not (length< (cadr args) i))
(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)
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 (tramp-local-environment-variable-p elt)
(if (string-search "=" elt)
(setq env (append env `(,elt)))
(setq uenv (cons elt uenv))))))
(env (setenv-internal
env "INSIDE_EMACS" (tramp-inside-emacs) 'keep))
(command
(when (stringp program)
(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)))
;; We do not want to raise an error when `make-process'
;; has been started several times in `eshell' and
;; friends.
tramp-current-connection
p)
;; Handle error buffer.
(when (bufferp stderr)
(unless (tramp-get-remote-mknod-or-mkfifo v)
(tramp-error
v 'file-error "Stderr buffer `%s' not supported" stderr))
(with-current-buffer stderr
(setq buffer-read-only nil))
(tramp-taint-remote-process-buffer stderr)
;; Create named pipe.
(tramp-send-command
v (format (tramp-get-remote-mknod-or-mkfifo v) tmpstderr))
;; Create stderr process.
(make-process
:name (buffer-name stderr)
:buffer stderr
:command `("cat" ,tmpstderr)
:coding coding
:noquery t
:filter nil
:sentinel #'ignore
:file-handler t))
(with-tramp-saved-connection-properties
v '(" process-name" " process-buffer")
;; 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))
(coding-system-for-write
(if (symbolp coding) coding (car coding)))
(coding-system-for-read
(if (symbolp coding) coding (cdr coding))))
(clear-visited-file-modtime)
(narrow-to-region (point-max) (point-max))
(catch 'suppress
;; Set the pid of the remote shell. This is
;; needed when sending signals remotely.
(let ((pid (tramp-send-command-and-read v "echo $$")))
(setq p (tramp-get-connection-process v))
(process-put p 'remote-pid pid))
(when
(or (memq connection-type '(nil pipe))
(tramp-check-remote-uname v tramp-sunos-unames))
;; Disable carriage return to newline
;; translation. This does not work on
;; macOS, see Bug#50748.
;; We must also disable buffering, otherwise
;; strings larger than 4096 bytes, sent by
;; the process, could block, see termios(3)
;; and Bug#61341.
;; In order to prevent blocking read from
;; pipe processes, "stty -icanon" is used.
;; By default, it expects at least one
;; character to read. When a process does
;; not read from stdin, like magit, it
;; should set a timeout
;; instead. See `tramp-pipe-stty-settings'.
;; (Bug#62093)
;; On Solaris, the maximum line length
;; depends also on MAX_CANON (256). So we
;; disable buffering as well.
;; FIXME: Shall we rather use "stty raw"?
(tramp-send-command
v (format
"stty %s %s"
(if (tramp-check-remote-uname v "Darwin")
"" "-icrnl")
tramp-pipe-stty-settings)))
;; `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))
(process-put p 'remote-command orig-command)
;; 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
;; `delete-file' will fail.
(tramp-flush-connection-property v " process-name")
(tramp-flush-connection-property v " process-buffer")
;; Kill stderr process and delete named pipe.
(when (bufferp stderr)
(add-function
:after (process-sentinel p)
(lambda (_proc _msg)
(ignore-errors
(while (accept-process-output
(get-buffer-process stderr) 0 nil t))
(delete-process (get-buffer-process stderr)))
(ignore-errors
(delete-file remote-tmpstderr)))))
;; Return process.
p)))
;; Save exit.
(if (string-prefix-p tramp-temp-buffer-name (buffer-name))
(ignore-errors
(set-process-buffer p nil)
(kill-buffer (current-buffer)))
(set-buffer-modified-p bmp)))))))))