Function: tramp-handle-make-process

tramp-handle-make-process is a byte-compiled function defined in tramp.el.gz.

Signature

(tramp-handle-make-process &rest ARGS)

Documentation

An alternative make-process implementation for Tramp files.

Source Code

;; Defined in /usr/src/emacs/lisp/net/tramp.el.gz
(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)))

	(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)))))
	       (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)
                     `(,(mapconcat #'identity command " ")))
		  command)))

	  ;; 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))
		 (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)

	    ;; Replace `login-args' place holders.  Split
	    ;; ControlMaster options.
	    (setq
	     login-args
	     (append
	      (tramp-compat-flatten-tree
	       (tramp-get-method-parameter v 'tramp-async-args))
	      (tramp-compat-flatten-tree
	       (mapcar
		(lambda (x) (split-string x " "))
		(tramp-expand-args
		 v 'tramp-login-args
		 ?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 ""))))
	     p (make-process
		:name name :buffer buffer
		:command (append `(,login-program) login-args command)
		:coding coding :noquery noquery :connection-type connection-type
		:sentinel sentinel :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))
	    (process-put p 'tramp-vector v)
	    ;; 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)

	    (tramp-message v 6 "%s" (string-join (process-command p) " "))
	    p))))))