;; terminated.
(defun tramp-adb-handle-make-process (&rest args)
"Like `make-process' for Tramp files.
-If method parameter `tramp-direct-async' and connection property
-\"direct-async-process\" are non-nil, an alternative
-implementation will be used."
+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)
- (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
- (or (plist-get args :connection-type) process-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 (bufferp buffer) (string-or-null-p buffer))
- (signal 'wrong-type-argument (list #'bufferp 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)))
- (when (eq connection-type t)
- (setq connection-type 'pty))
- (unless (or (and (consp connection-type)
- (memq (car connection-type) '(nil pipe pty))
- (memq (cdr connection-type) '(nil pipe pty)))
- (memq connection-type '(nil pipe pty)))
- (signal 'wrong-type-argument (list #'symbolp connection-type)))
- (unless (or (null filter) (eq filter t) (functionp filter))
- (signal 'wrong-type-argument (list #'functionp filter)))
- (unless (or (null sentinel) (functionp sentinel))
- (signal 'wrong-type-argument (list #'functionp sentinel)))
- (unless (or (bufferp stderr) (string-or-null-p stderr))
- (signal 'wrong-type-argument (list #'bufferp 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)))
- (orig-command command)
- (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)
- p)
-
- (when (string-match-p (rx multibyte) command)
- (tramp-error
- v 'file-error "Cannot apply multibyte command `%s'" command))
-
- (while (get-process name1)
- ;; NAME must be unique as process name.
- (setq i (1+ i)
- name1 (format "%s<%d>" name i)))
- (setq name name1)
-
- (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)
- (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))
- ;; 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.
- (setq 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))
- (process-put p 'remote-command orig-command)
- (tramp-set-connection-property
- 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 `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.
- (unless (eq filter t)
- (while
- (progn
- (goto-char (point-min))
- (not (search-forward "\n" nil t)))
- (tramp-accept-process-output p))
- (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)
- (ignore-errors
- (tramp-taint-remote-process-buffer stderr)
- (with-current-buffer stderr
- (insert-file-contents-literally
- remote-tmpstderr 'visit)))
- ;; Delete tmpstderr file.
- (add-function
- :after (process-sentinel p)
- (lambda (_proc _msg)
- (ignore-errors
- (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-prefix-p tramp-temp-buffer-name (buffer-name))
+ (tramp-skeleton-make-process args nil t
+ (let* ((program (car command))
+ (args (cdr command))
+ ;; 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)))
+ (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)
+ p)
+
+ (when (string-match-p (rx multibyte) command)
+ (tramp-error
+ v 'file-error "Cannot apply multibyte command `%s'" command))
+
+ (while (get-process name1)
+ ;; NAME must be unique as process name.
+ (setq i (1+ i)
+ name1 (format "%s<%d>" name i)))
+ (setq name name1)
+
+ (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)
+ (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))
+ ;; 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.
+ (setq 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))
+ (process-put p 'remote-command orig-command)
+ (tramp-set-connection-property
+ 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-buffer p nil)
- (kill-buffer (current-buffer)))
- (set-buffer-modified-p bmp)))))))))))
+ (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.
+ (unless (eq filter t)
+ (while (progn
+ (goto-char (point-min))
+ (not (search-forward "\n" nil t)))
+ (tramp-accept-process-output p))
+ (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)
+ (ignore-errors
+ (tramp-taint-remote-process-buffer stderr)
+ (with-current-buffer stderr
+ (insert-file-contents-literally
+ remote-tmpstderr 'visit)))
+ ;; Delete tmpstderr file.
+ (add-function
+ :after (process-sentinel p)
+ (lambda (_proc _msg)
+ (ignore-errors
+ (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-prefix-p tramp-temp-buffer-name (buffer-name))
+ (ignore-errors
+ (set-process-buffer p nil)
+ (kill-buffer (current-buffer)))
+ (set-buffer-modified-p bmp)))))))))
(defun tramp-adb-handle-exec-path ()
"Like `exec-path' for Tramp files."
(defun tramp-androidsu-handle-make-process (&rest args)
"Like `tramp-handle-make-process', but modified for Android."
- (when args
- (with-parsed-tramp-file-name (expand-file-name default-directory) nil
- (let ((default-directory tramp-compat-temporary-file-directory)
- (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
- (or (plist-get args :connection-type) process-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 (bufferp buffer) (string-or-null-p buffer))
- (signal 'wrong-type-argument (list #'bufferp 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)))
- (when (eq connection-type t)
- (setq connection-type 'pty))
- (unless (or (and (consp connection-type)
- (memq (car connection-type) '(nil pipe pty))
- (memq (cdr connection-type) '(nil pipe pty)))
- (memq connection-type '(nil pipe pty)))
- (signal 'wrong-type-argument (list #'symbolp connection-type)))
- (unless (or (null filter) (eq filter t) (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))
- (signal 'wrong-type-argument (list #'bufferp 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)))
- (orig-command command)
- (env (mapcar
- (lambda (elt)
- (when (tramp-compat-string-search "=" elt) elt))
- tramp-remote-process-environment))
- ;; We use as environment the difference to toplevel
- ;; `process-environment'.
- (env (dolist (elt process-environment env)
- (when
- (and
- (tramp-compat-string-search "=" elt)
- (not
- (member
- elt (default-toplevel-value 'process-environment))))
- (setq env (cons elt env)))))
- ;; Add remote path if exists.
- (env (let ((remote-path
- (string-join (tramp-get-remote-path v) ":")))
- (setenv-internal env "PATH" remote-path 'keep)))
- (env (setenv-internal
- env "INSIDE_EMACS" (tramp-inside-emacs) 'keep))
- (env (mapcar #'tramp-shell-quote-argument (delq nil env)))
- ;; Quote command.
- (command (mapconcat #'tramp-shell-quote-argument command " "))
- ;; Set cwd and environment variables.
- (command
- (append
- `("cd" ,(tramp-shell-quote-argument localname) "&&" "(" "env")
- env `(,command ")")))
- ;; Add remote shell if needed.
- (command
- (if (consp (tramp-get-method-parameter v 'tramp-direct-async))
- (append
- (tramp-get-method-parameter v 'tramp-direct-async)
- `(,(string-join command " ")))
- command))
- p)
- ;; Generate a command to start the process using `su' with
- ;; suitable options for specifying the mount namespace and
- ;; suchlike.
- ;; Suppress `internal-default-process-sentinel', which is
- ;; set when :sentinel is nil. (Bug#71049)
- (setq
- p (let ((android-use-exec-loader nil))
- (make-process
- :name name
- :buffer buffer
- :command
- (if (equal user "root")
- ;; Invoke su in the simplest manner possible, that
- ;; is to say, without specifying the user, which
- ;; certain implementations cannot parse when a
- ;; command is also present, if it may be omitted, so
- ;; that starting inferior shells on systems with
- ;; such implementations does not needlessly fail.
- (if (tramp-get-connection-property v "remote-namespace")
- (append (list "su" "-mm" "-c") command)
- (append (list "su" "-c") command))
- (if (tramp-get-connection-property v "remote-namespace")
- (append (list "su" "-mm" "-" user "-c") command)
- (append (list "su" "-" user "-c") command)))
- :coding coding
- :noquery noquery
- :connection-type connection-type
- :sentinel (or sentinel #'ignore)
- :stderr stderr)))
- ;; Set filter. Prior Emacs 29.1, it doesn't work reliably
- ;; to provide it as `make-process' argument when filter is
- ;; t. See Bug#51177.
- (when filter
- (set-process-filter p filter))
- (tramp-post-process-creation p v)
- ;; Query flag is overwritten in `tramp-post-process-creation',
- ;; so we reset it.
- (set-process-query-on-exit-flag p (null noquery))
- ;; This is needed for ssh or PuTTY based processes, and
- ;; only if the respective options are set. Perhaps, the
- ;; setting could be more fine-grained.
- ;; (process-put p 'tramp-shared-socket t)
- (process-put p 'remote-command orig-command)
- (tramp-set-connection-property p "remote-command" orig-command)
- (when (bufferp stderr)
- (tramp-taint-remote-process-buffer stderr))
- p)))))
+ (tramp-skeleton-make-process args nil nil
+ (let* ((env (mapcar
+ (lambda (elt)
+ (when (tramp-compat-string-search "=" elt) elt))
+ tramp-remote-process-environment))
+ ;; We use as environment the difference to toplevel
+ ;; `process-environment'.
+ (env (dolist (elt process-environment env)
+ (when
+ (and
+ (tramp-compat-string-search "=" elt)
+ (not
+ (member
+ elt (default-toplevel-value 'process-environment))))
+ (setq env (cons elt env)))))
+ ;; Add remote path if exists.
+ (env (let ((remote-path (string-join (tramp-get-remote-path v) ":")))
+ (setenv-internal env "PATH" remote-path 'keep)))
+ (env (setenv-internal env "INSIDE_EMACS" (tramp-inside-emacs) 'keep))
+ (env (mapcar #'tramp-shell-quote-argument (delq nil env)))
+ ;; Quote command.
+ (command (mapconcat #'tramp-shell-quote-argument command " "))
+ ;; Set cwd and environment variables.
+ (command
+ (append
+ `("cd" ,(tramp-shell-quote-argument localname) "&&" "(" "env")
+ env `(,command ")")))
+ ;; Add remote shell if needed.
+ (command
+ (if (consp (tramp-get-method-parameter v 'tramp-direct-async))
+ (append
+ (tramp-get-method-parameter v 'tramp-direct-async)
+ `(,(string-join command " ")))
+ command))
+ p)
+ ;; Generate a command to start the process using `su' with
+ ;; suitable options for specifying the mount namespace and
+ ;; suchlike.
+ ;; Suppress `internal-default-process-sentinel', which is set
+ ;; when :sentinel is nil. (Bug#71049)
+ (setq
+ p (let ((android-use-exec-loader nil))
+ (make-process
+ :name name
+ :buffer buffer
+ :command
+ (if (equal user "root")
+ ;; Invoke su in the simplest manner possible, that
+ ;; is to say, without specifying the user, which
+ ;; certain implementations cannot parse when a
+ ;; command is also present, if it may be omitted, so
+ ;; that starting inferior shells on systems with
+ ;; such implementations does not needlessly fail.
+ (if (tramp-get-connection-property v "remote-namespace")
+ (append (list "su" "-mm" "-c") command)
+ (append (list "su" "-c") command))
+ (if (tramp-get-connection-property v "remote-namespace")
+ (append (list "su" "-mm" "-" user "-c") command)
+ (append (list "su" "-" user "-c") command)))
+ :coding coding
+ :noquery noquery
+ :connection-type connection-type
+ :sentinel (or sentinel #'ignore)
+ :stderr stderr)))
+ ;; Set filter. Prior Emacs 29.1, it doesn't work reliably to
+ ;; provide it as `make-process' argument when filter is t. See
+ ;; Bug#51177.
+ (when filter
+ (set-process-filter p filter))
+ (tramp-post-process-creation p v)
+ ;; Query flag is overwritten in `tramp-post-process-creation',
+ ;; so we reset it.
+ (set-process-query-on-exit-flag p (null noquery))
+ (process-put p 'remote-command orig-command)
+ (tramp-set-connection-property p "remote-command" orig-command)
+ (when (bufferp stderr)
+ (tramp-taint-remote-process-buffer stderr))
+ p)))
(defalias 'tramp-androidsu-handle-make-symbolic-link
#'tramp-sh-handle-make-symbolic-link)
;;; Code:
(require 'tramp)
-(defvar tramp-actions-before-shell)
;;;###tramp-autoload
(defcustom tramp-docker-program "docker"
:version "30.1"
:type '(alist :key-type regexp :value-type string))
+;;;###tramp-autoload
(defconst tramp-actions-before-shell
'((tramp-login-prompt-regexp tramp-action-login)
(tramp-password-prompt-regexp tramp-action-password)
(tramp-get-connection-name v)
(tramp-get-connection-buffer v)
copy-program copy-args)))
- ;; This is needed for ssh or PuTTY based processes, and
- ;; only if the respective options are set. Perhaps,
- ;; the setting could be more fine-grained.
+ ;; This is needed for ssh or PuTTY based processes,
+ ;; and only if the respective options are set.
+ ;; Perhaps, the setting could be more fine-grained.
;; (process-put p 'tramp-shared-socket t)
(tramp-post-process-creation p v)
(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 property
-\"direct-async-process\" are non-nil, an alternative
-implementation will be used."
+`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)
- (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
- (or (plist-get args :connection-type) process-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 (bufferp buffer) (string-or-null-p buffer))
- (signal 'wrong-type-argument (list #'bufferp buffer)))
- (unless (or (null command) (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)))
- (when (eq connection-type t)
- (setq connection-type 'pty))
- (unless (or (and (consp connection-type)
- (memq (car connection-type) '(nil pipe pty))
- (memq (cdr connection-type) '(nil pipe pty)))
- (memq connection-type '(nil pipe pty)))
- (signal 'wrong-type-argument (list #'symbolp connection-type)))
- (unless (or (null filter) (eq filter t) (functionp filter))
- (signal 'wrong-type-argument (list #'functionp filter)))
- (unless (or (null sentinel) (functionp sentinel))
- (signal 'wrong-type-argument (list #'functionp sentinel)))
- (unless (or (bufferp stderr) (string-or-null-p stderr))
- (signal 'wrong-type-argument (list #'bufferp stderr)))
- (when (and (stringp 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
- (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)))
- (orig-command command)
- (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 (not (bufferp stderr))
- (stringp program)
- (string-match-p (rx "sh" eol) program)
- (tramp-compat-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 (tramp-compat-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 (member
- elt (default-toplevel-value 'process-environment))
- (if (tramp-compat-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)))
- (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)
-
- ;; 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))
-
- (while (get-process name1)
- ;; NAME must be unique as process name.
- (setq i (1+ i)
- name1 (format "%s<%d>" name i)))
- (setq name name1)
-
- (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)
- (tramp-set-connection-property
- p "remote-pid" pid))
- (when (memq connection-type '(nil pipe))
- ;; 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)
- ;; 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)
- (tramp-set-connection-property
- 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))
+ (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)
+ (tramp-compat-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 (tramp-compat-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 (member
+ elt (default-toplevel-value 'process-environment))
+ (if (tramp-compat-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)))
+ (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)
+
+ ;; 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))
+
+ (while (get-process name1)
+ ;; NAME must be unique as process name.
+ (setq i (1+ i)
+ name1 (format "%s<%d>" name i)))
+ (setq name name1)
+
+ (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)
+ (tramp-set-connection-property p "remote-pid" pid))
+ (when (memq connection-type '(nil pipe))
+ ;; 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)
+ ;; 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)
+ (tramp-set-connection-property
+ 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-buffer p nil)
- (kill-buffer (current-buffer)))
- (set-buffer-modified-p bmp)))))))))))
+ (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)))))))))
(defun tramp-sh-get-signal-strings (vec)
"Strings to return by `process-file' in case of signals."
;;;###tramp-autoload
(defun tramp-file-local-name (name)
"Return the local name component of NAME.
-This function removes from NAME the specification of the remote
-host and the method of accessing the host, leaving only the part
-that identifies NAME locally on the remote system. If NAME does
-not match `tramp-file-name-regexp', just `file-local-name' is
-called. The returned file name can be used directly as argument
-of `process-file', `start-file-process', or `shell-command'."
+This function removes from NAME the specification of the remote host and
+the method of accessing the host, leaving only the part that identifies
+NAME locally on the remote system. If NAME does not match
+`tramp-file-name-regexp', just `file-local-name' is called. The
+returned file name can be used directly as argument of `make-process',
+`process-file', `start-file-process', or `shell-command'."
(or (and (tramp-tramp-file-p name)
(string-match (nth 0 tramp-file-name-structure) name)
(match-string (nth 4 tramp-file-name-structure) name))
(let ((tramp-verbose 0)
(vec (tramp-ensure-dissected-file-name vec-or-filename)))
(or ;; We check this for the process related to
- ;; `tramp-buffer-name'; otherwise `start-file-process'
- ;; wouldn't run ever when `non-essential' is non-nil.
+ ;; `tramp-buffer-name'; otherwise `make-process' wouldn't run
+ ;; ever when `non-essential' is non-nil.
(process-live-p (tramp-get-process vec))
(not non-essential))))
,@body
nil))))
+(defmacro tramp-skeleton-make-process (args null-command stderr-file &rest body)
+ "Skeleton for `tramp-*-handle-make-process'.
+NULL-COMMAND indicates a possible empty command. STDERR-FILE means,
+that a stederr file is supported. BODY is the backend specific code."
+ (declare (indent 3) (debug t))
+ `(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
+ (or (plist-get ,args :connection-type) process-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 (bufferp buffer) (string-or-null-p buffer))
+ (signal 'wrong-type-argument (list #'bufferp buffer)))
+ (unless (or (consp command) (and ,null-command (null 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)))
+ (when (eq connection-type t)
+ (setq connection-type 'pty))
+ (unless (or (and (consp connection-type)
+ (memq (car connection-type) '(nil pipe pty))
+ (memq (cdr connection-type) '(nil pipe pty)))
+ (memq connection-type '(nil pipe pty)))
+ (signal 'wrong-type-argument (list #'symbolp connection-type)))
+ (unless (or (null filter) (eq filter t) (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)
+ (and ,stderr-file (stringp stderr)))
+ (signal 'wrong-type-argument (list #'bufferp stderr)))
+ (when (and (stringp stderr)
+ (not (tramp-equal-remote default-directory stderr)))
+ (signal 'file-error (list "Wrong stderr" stderr)))
+
+ (let ((default-directory tramp-compat-temporary-file-directory)
+ (buffer
+ (if buffer
+ (get-buffer-create buffer)
+ ;; BUFFER can be nil. We use a temporary buffer.
+ (generate-new-buffer tramp-temp-buffer-name)))
+ (orig-command command))
+
+ ,@body)))))
+
(defmacro tramp-skeleton-make-symbolic-link
(target linkname &optional ok-if-already-exists &rest body)
"Skeleton for `tramp-*-handle-make-symbolic-link'.
(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 ((default-directory tramp-compat-temporary-file-directory)
- (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
- (or (plist-get args :connection-type) process-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 (bufferp buffer) (string-or-null-p buffer))
- (signal 'wrong-type-argument (list #'bufferp 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)))
- (when (eq connection-type t)
- (setq connection-type 'pty))
- (unless (or (and (consp connection-type)
- (memq (car connection-type) '(nil pipe pty))
- (memq (cdr connection-type) '(nil pipe pty)))
- (memq connection-type '(nil pipe pty)))
- (signal 'wrong-type-argument (list #'symbolp connection-type)))
- (unless (or (null filter) (eq filter t) (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))
- (signal 'wrong-type-argument (list #'bufferp stderr)))
-
- ;; Check for `tramp-sh-file-name-handler', because something
- ;; is different between tramp-sh.el, and tramp-adb.el or
- ;; tramp-sshfs.el.
- (let* ((sh-file-name-handler-p (tramp-sh-file-name-handler-p v))
- (adb-file-name-handler-p (tramp-adb-file-name-p v))
- (buffer
- (if buffer
- (get-buffer-create buffer)
- ;; BUFFER can be nil. We use a temporary buffer.
- (generate-new-buffer tramp-temp-buffer-name)))
- (orig-command command)
- (env (mapcar
- (lambda (elt)
- (when (tramp-compat-string-search "=" elt) elt))
- tramp-remote-process-environment))
- ;; We use as environment the difference to toplevel
- ;; `process-environment'.
- (env (dolist (elt process-environment env)
- (when
- (and
- (tramp-compat-string-search "=" elt)
- (not
- (member
- elt (default-toplevel-value 'process-environment))))
- (setq env (cons elt env)))))
- ;; Add remote path if exists.
- (env (if-let ((sh-file-name-handler-p)
- (remote-path
- (string-join (tramp-get-remote-path v) ":")))
- (setenv-internal env "PATH" remote-path 'keep)
- env))
- ;; Add HISTFILE if indicated.
- (env (if-let ((sh-file-name-handler-p))
- (cond
- ((stringp tramp-histfile-override)
- (setenv-internal env "HISTFILE" tramp-histfile-override 'keep))
- (tramp-histfile-override
- (setq env (setenv-internal env "HISTFILE" "''" 'keep))
- (setq env (setenv-internal env "HISTSIZE" "0" 'keep))
- (setenv-internal env "HISTFILESIZE" "0" 'keep))
- (t env))
- env))
- ;; Add INSIDE_EMACS.
- (env (setenv-internal
- env "INSIDE_EMACS" (tramp-inside-emacs) 'keep))
- (env (mapcar #'tramp-shell-quote-argument (delq nil env)))
- ;; Quote command.
- (command (mapconcat #'tramp-shell-quote-argument command " "))
- ;; Set cwd and environment variables.
- (command
- (append
- `("cd" ,(tramp-shell-quote-argument localname) "&&" "(" "env")
- env `(,command ")")))
- ;; Add remote shell if needed.
- (command
- (if (consp (tramp-get-method-parameter v 'tramp-direct-async))
- (append
- (tramp-get-method-parameter v 'tramp-direct-async)
- `(,(string-join command " ")))
- command))
- (login-program
- (tramp-get-method-parameter v 'tramp-login-program))
- ;; We don't create the temporary file. In fact, it is
- ;; just a prefix for the ControlPath option of ssh; the
- ;; real temporary file has another name, and it is
- ;; created and protected by ssh. It is also removed by
- ;; ssh when the connection is closed. The temporary
- ;; file name is cached in the main connection process,
- ;; therefore we cannot use
- ;; `tramp-get-connection-process'.
- (tmpfile
- (when sh-file-name-handler-p
- (with-tramp-connection-property
- (tramp-get-process v) "temp-file"
- (tramp-compat-make-temp-name))))
- (options
- (when sh-file-name-handler-p
- (tramp-compat-funcall
- 'tramp-ssh-controlmaster-options v)))
- (device
- (when adb-file-name-handler-p
- (tramp-compat-funcall
- 'tramp-adb-get-device v)))
- (pta (unless (eq connection-type 'pipe) "-t"))
- login-args p)
-
- ;; Command could be too long, for example due to a longish PATH.
- (when (and sh-file-name-handler-p
- (tramp-compat-length>
- (string-join command) (tramp-get-remote-pipe-buf v)))
- (signal 'error (cons "Command too long:" command)))
-
- (setq
- ;; Replace `login-args' place holders. Split ControlMaster
- ;; options.
- login-args
- (append
- (flatten-tree (tramp-get-method-parameter v 'tramp-async-args))
- (flatten-tree
- (mapcar
- (lambda (x) (split-string x " "))
- (tramp-expand-args
- v 'tramp-login-args nil
- ?h (or host "") ?u (or user "") ?p (or port "")
- ?c (format-spec (or options "") (format-spec-make ?t tmpfile))
- ?d (or device "") ?a (or pta "") ?l ""))))
- ;; Suppress `internal-default-process-sentinel', which is
- ;; set when :sentinel is nil. (Bug#71049)
- p (make-process
- :name name :buffer buffer
- :command (append `(,login-program) login-args command)
- :coding coding :noquery noquery :connection-type connection-type
- :sentinel (or sentinel #'ignore) :stderr stderr))
- ;; Set filter. Prior Emacs 29.1, it doesn't work reliably
- ;; to provide it as `make-process' argument when filter is
- ;; t. See Bug#51177.
- (when filter
- (set-process-filter p filter))
- (tramp-post-process-creation p v)
- ;; Query flag is overwritten in `tramp-post-process-creation',
- ;; so we reset it.
- (set-process-query-on-exit-flag p (null noquery))
- ;; This is needed for ssh or PuTTY based processes, and
- ;; only if the respective options are set. Perhaps, the
- ;; setting could be more fine-grained.
- ;; (process-put p 'tramp-shared-socket t)
- (process-put p 'remote-command orig-command)
- (tramp-set-connection-property p "remote-command" orig-command)
- (when (bufferp stderr)
- (tramp-taint-remote-process-buffer stderr))
-
- p)))))
+ (tramp-skeleton-make-process args nil nil
+ ;; Check for `tramp-sh-file-name-handler' and
+ ;; `adb-file-name-handler-p', because something is different
+ ;; between tramp-sh.el, and tramp-adb.el or tramp-sshfs.el.
+ (let* ((sh-file-name-handler-p (tramp-sh-file-name-handler-p v))
+ (adb-file-name-handler-p (tramp-adb-file-name-p v))
+ (env (mapcar
+ (lambda (elt)
+ (when (tramp-compat-string-search "=" elt) elt))
+ tramp-remote-process-environment))
+ ;; We use as environment the difference to toplevel
+ ;; `process-environment'.
+ (env (dolist (elt process-environment env)
+ (when (and
+ (tramp-compat-string-search "=" elt)
+ (not
+ (member
+ elt (default-toplevel-value 'process-environment))))
+ (setq env (cons elt env)))))
+ ;; Add remote path if exists.
+ (env (if-let ((sh-file-name-handler-p)
+ (remote-path
+ (string-join (tramp-get-remote-path v) ":")))
+ (setenv-internal env "PATH" remote-path 'keep)
+ env))
+ ;; Add HISTFILE if indicated.
+ (env (if-let ((sh-file-name-handler-p))
+ (cond
+ ((stringp tramp-histfile-override)
+ (setenv-internal
+ env "HISTFILE" tramp-histfile-override 'keep))
+ (tramp-histfile-override
+ (setq env (setenv-internal env "HISTFILE" "''" 'keep))
+ (setq env (setenv-internal env "HISTSIZE" "0" 'keep))
+ (setenv-internal env "HISTFILESIZE" "0" 'keep))
+ (t env))
+ env))
+ ;; Add INSIDE_EMACS.
+ (env (setenv-internal env "INSIDE_EMACS" (tramp-inside-emacs) 'keep))
+ (env (mapcar #'tramp-shell-quote-argument (delq nil env)))
+ ;; Quote command.
+ (command (mapconcat #'tramp-shell-quote-argument command " "))
+ ;; Set cwd and environment variables.
+ (command
+ (append
+ `("cd" ,(tramp-shell-quote-argument localname) "&&" "(" "env")
+ env `(,command ")")))
+ ;; Add remote shell if needed.
+ (command
+ (if (consp (tramp-get-method-parameter v 'tramp-direct-async))
+ (append
+ (tramp-get-method-parameter v 'tramp-direct-async)
+ `(,(string-join command " ")))
+ command))
+ (login-program
+ (tramp-get-method-parameter v 'tramp-login-program))
+ ;; We don't create the temporary file. In fact, it is just
+ ;; a prefix for the ControlPath option of ssh; the real
+ ;; temporary file has another name, and it is created and
+ ;; protected by ssh. It is also removed by ssh when the
+ ;; connection is closed. The temporary file name is cached
+ ;; in the main connection process, therefore we cannot use
+ ;; `tramp-get-connection-process'.
+ (tmpfile
+ (when sh-file-name-handler-p
+ (with-tramp-connection-property
+ (tramp-get-process v) "temp-file"
+ (tramp-compat-make-temp-name))))
+ (options
+ (when sh-file-name-handler-p
+ (tramp-compat-funcall
+ 'tramp-ssh-controlmaster-options v)))
+ (device
+ (when adb-file-name-handler-p
+ (tramp-compat-funcall
+ 'tramp-adb-get-device v)))
+ (pta (unless (eq connection-type 'pipe) "-t"))
+ login-args p)
+
+ ;; Command could be too long, for example due to a longish PATH.
+ (when (and sh-file-name-handler-p
+ (tramp-compat-length>
+ (string-join command) (tramp-get-remote-pipe-buf v)))
+ (signal 'error (cons "Command too long:" command)))
+
+ (setq
+ ;; Replace `login-args' place holders. Split ControlMaster
+ ;; options.
+ login-args
+ (append
+ (flatten-tree (tramp-get-method-parameter v 'tramp-async-args))
+ (flatten-tree
+ (mapcar
+ (lambda (x) (split-string x " "))
+ (tramp-expand-args
+ v 'tramp-login-args nil
+ ?h (or host "") ?u (or user "") ?p (or port "")
+ ?c (format-spec (or options "") (format-spec-make ?t tmpfile))
+ ?d (or device "") ?a (or pta "") ?l ""))))
+ ;; Suppress `internal-default-process-sentinel', which is set
+ ;; when :sentinel is nil. (Bug#71049)
+ p (make-process
+ :name name :buffer buffer
+ :command (append `(,login-program) login-args command)
+ :coding coding :noquery noquery :connection-type connection-type
+ :sentinel (or sentinel #'ignore) :stderr stderr))
+ ;; Set filter. Prior Emacs 29.1, it doesn't work reliably to
+ ;; provide it as `make-process' argument when filter is t. See
+ ;; Bug#51177.
+ (when filter
+ (set-process-filter p filter))
+ (tramp-post-process-creation p v)
+ ;; Query flag is overwritten in `tramp-post-process-creation',
+ ;; so we reset it.
+ (set-process-query-on-exit-flag p (null noquery))
+ ;; This is needed for ssh or PuTTY based processes, and only if
+ ;; the respective options are set. Perhaps, the setting could
+ ;; be more fine-grained.
+ ;; (process-put p 'tramp-shared-socket t)
+ (process-put p 'remote-command orig-command)
+ (tramp-set-connection-property p "remote-command" orig-command)
+ (when (bufferp stderr)
+ (tramp-taint-remote-process-buffer stderr))
+
+ p)))
(defun tramp-handle-make-symbolic-link
(_target linkname &optional _ok-if-already-exists)
projects / emacs.git / commitdiff