From a9b4190b27fd1f1fcd9abeb5bcce5482ce80a97f Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 10 Jun 2024 14:37:48 +0200 Subject: [PATCH] Refactor tramp-*-make-process functions * lisp/net/tramp.el (tramp-handle-make-process): * lisp/net/tramp-adb.el (tramp-adb-handle-make-process): * lisp/net/tramp-androidsu.el (tramp-androidsu-handle-make-process): * lisp/net/tramp-sh.el (tramp-sh-handle-make-process): Use `tramp-skeleton-make-process'. * lisp/net/tramp-container.el (tramp-actions-before-shell): Don't declare. * lisp/net/tramp-sh.el (tramp-actions-before-shell): Add ;;;###tramp-autoload cookie. * lisp/net/tramp.el (tramp-file-local-name): Adapt docstring. (tramp-skeleton-make-process): New defmacro. (cherry picked from commit 9b12854743ad4c9fdd44bd9ce2f9b309e0c674cf) --- lisp/net/tramp-adb.el | 308 ++++++++++------------ lisp/net/tramp-androidsu.el | 205 ++++++--------- lisp/net/tramp-container.el | 1 - lisp/net/tramp-sh.el | 495 ++++++++++++++++-------------------- lisp/net/tramp.el | 369 ++++++++++++++------------- 5 files changed, 619 insertions(+), 759 deletions(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 9db313e3ed0..89695793f3b 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -842,187 +842,139 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; 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." diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index b2f0bab650d..dae90202478 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -302,133 +302,84 @@ FUNCTION." (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) diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el index f29d55d78d9..02512e64ef6 100644 --- a/lisp/net/tramp-container.el +++ b/lisp/net/tramp-container.el @@ -118,7 +118,6 @@ ;;; Code: (require 'tramp) -(defvar tramp-actions-before-shell) ;;;###tramp-autoload (defcustom tramp-docker-program "docker" diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index e92f5ef2d64..4acc2fc8de9 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -591,6 +591,7 @@ shell from reading its init file." :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) @@ -2589,9 +2590,9 @@ The method used must be an out-of-band method." (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) @@ -2972,280 +2973,226 @@ This is used in `make-process' with `connection-type' `pipe'." (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) " 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) " 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." diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 0dc9109a484..a65fd45dd9d 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1633,12 +1633,12 @@ entry does not exist, return DEFAULT." ;;;###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)) @@ -2687,8 +2687,8 @@ not in completion mode." (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)))) @@ -3510,6 +3510,63 @@ BODY is the backend specific code." ,@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'. @@ -4883,177 +4940,131 @@ should be set connection-local.") (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) -- 2.39.2