Function: tramp-sh-handle-process-file

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

Signature

(tramp-sh-handle-process-file PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS)

Documentation

Like process-file for Tramp files.

Source Code

;; Defined in /usr/src/emacs/lisp/net/tramp-sh.el.gz
(defun tramp-sh-handle-process-file
  (program &optional infile destination display &rest args)
  "Like `process-file' for Tramp files."
  ;; The implementation is not complete yet.
  (when (and (numberp destination) (zerop destination))
    (error "Implementation does not handle immediate return"))

  (with-parsed-tramp-file-name (expand-file-name default-directory) nil
    (let (command env uenv input tmpinput stderr tmpstderr outbuf ret)
      ;; Compute command.
      (setq command (mapconcat #'tramp-shell-quote-argument
			       (cons program args) " "))
      ;; We use as environment the difference to toplevel `process-environment'.
      (dolist (elt process-environment)
        (or (member elt (default-toplevel-value 'process-environment))
            (if (tramp-compat-string-search "=" elt)
                (setq env (append env `(,elt)))
              (setq uenv (cons elt uenv)))))
      (setq env (setenv-internal env "INSIDE_EMACS" (tramp-inside-emacs) 'keep))
      (when env
	(setq command
	      (format
	       "env %s %s"
	       (mapconcat #'tramp-shell-quote-argument env " ") command)))
      (when uenv
        (setq command
              (format
               "unset %s && %s"
               (mapconcat #'tramp-shell-quote-argument uenv " ") command)))
      ;; Determine input.
      (if (null infile)
	  (setq input (tramp-get-remote-null-device v))
	(setq infile (tramp-compat-file-name-unquote (expand-file-name infile)))
	(if (tramp-equal-remote default-directory infile)
	    ;; INFILE is on the same remote host.
	    (setq input (tramp-unquote-file-local-name infile))
	  ;; INFILE must be copied to remote host.
	  (setq input (tramp-make-tramp-temp-file v)
		tmpinput (tramp-make-tramp-file-name v input))
	  (copy-file infile tmpinput t)))
      (when input (setq command (format "%s <%s" command input)))

      ;; Determine output.
      (cond
       ;; Just a buffer.
       ((bufferp destination)
	(setq outbuf destination))
       ;; A buffer name.
       ((stringp destination)
	(setq outbuf (get-buffer-create destination)))
       ;; (REAL-DESTINATION ERROR-DESTINATION)
       ((consp destination)
	;; output.
	(cond
	 ((bufferp (car destination))
	  (setq outbuf (car destination)))
	 ((stringp (car destination))
	  (setq outbuf (get-buffer-create (car destination))))
	 ((car destination)
	  (setq outbuf (current-buffer))))
	;; stderr.
	(cond
	 ((stringp (cadr destination))
	  (setcar (cdr destination) (expand-file-name (cadr destination)))
	  (if (tramp-equal-remote default-directory (cadr destination))
	      ;; stderr is on the same remote host.
	      (setq stderr (tramp-unquote-file-local-name (cadr destination)))
	    ;; stderr must be copied to remote host.  The temporary
	    ;; file must be deleted after execution.
	    (setq stderr (tramp-make-tramp-temp-file v)
		  tmpstderr (tramp-make-tramp-file-name v stderr))))
	 ;; stderr to be discarded.
	 ((null (cadr destination))
	  (setq stderr (tramp-get-remote-null-device v)))))
       ;; 't
       (destination
	(setq outbuf (current-buffer))))
      (when stderr (setq command (format "%s 2>%s" command stderr)))

      ;; Send the command.  It might not return in time, so we protect
      ;; it.  Call it in a subshell, in order to preserve working
      ;; directory.
      (condition-case nil
	  (unwind-protect
              (setq ret (tramp-send-command-and-check
			 v (format
			    "cd %s && %s"
			    (tramp-unquote-shell-quote-argument localname)
			    command)
			 t t t))
	    (unless (natnump ret) (setq ret 1))
	    ;; We should add the output anyway.
	    (when outbuf
	      (with-current-buffer outbuf
                (insert
		 (tramp-get-buffer-string (tramp-get-connection-buffer v))))
	      (when (and display (get-buffer-window outbuf t)) (redisplay))))
	;; When the user did interrupt, we should do it also.  We use
	;; return code -1 as marker.
	(quit
	 (kill-buffer (tramp-get-connection-buffer v))
	 (setq ret -1))
	;; Handle errors.
	(error
	 (kill-buffer (tramp-get-connection-buffer v))
	 (setq ret 1)))

      ;; Handle signals.  `process-file-return-signal-string' exists
      ;; since Emacs 28.1.
      (when (and (bound-and-true-p process-file-return-signal-string)
		 (natnump ret) (>= ret 128))
	(setq ret (nth (- ret 128) (tramp-sh-get-signal-strings v))))

      ;; Provide error file.
      (when tmpstderr (rename-file tmpstderr (cadr destination) t))

      ;; Cleanup.  We remove all file cache values for the connection,
      ;; because the remote process could have changed them.
      (when tmpinput (delete-file tmpinput))
      (when process-file-side-effects
        (tramp-flush-directory-properties v "/"))

      ;; Return exit status.
      (if (equal ret -1)
	  (keyboard-quit)
	ret))))