(defun tramp-adb-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 input tmpinput stderr tmpstderr outbuf ret)
+ (tramp-skeleton-process-file program infile destination display args
;; Compute command.
(setq command (mapconcat #'tramp-shell-quote-argument
(cons program args) " "))
- ;; Determine input.
- (if (null infile)
- (setq input (tramp-get-remote-null-device v))
- (setq infile (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
;; 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-adb-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))))
+ (setq ret (nth (- ret 128) (tramp-adb-get-signal-strings v))))))
;; We use BUFFER also as connection buffer during setup. Because of
;; this, its original contents must be saved, and restored once
(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-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.
- ;; (process-put p 'tramp-shared-socket t)
(tramp-post-process-creation p v)
;; We must adapt `tramp-local-end-of-line' for sending
(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.
: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.
(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)
+ (tramp-skeleton-process-file program infile destination display args
+ (let (env uenv)
;; Compute command.
(setq command (mapconcat #'tramp-shell-quote-argument
(cons program args) " "))
(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 (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
;; 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))))
+ (setq ret (nth (- ret 128) (tramp-sh-get-signal-strings v)))))))
(defun tramp-sh-handle-exec-path ()
"Like `exec-path' for Tramp files."
v 'file-notify-error
"`%s' failed to start on remote host"
(string-join sequence " "))
- ;; 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)
;; Needed for process filter.
(process-put p 'tramp-events events)
(process-put p 'tramp-watch-name localname)
(and tramp-encoding-command-interactive
`(,tramp-encoding-command-interactive)))))))
- ;; 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)
;; Set sentinel. Initialize variables.
(set-process-sentinel p #'tramp-process-sentinel)
(tramp-post-process-creation p vec)
(defun tramp-sshfs-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"))
+ (tramp-skeleton-process-file program infile destination display args
+ (let ((coding-system-for-read 'utf-8-dos)) ; Is this correct?
- (with-parsed-tramp-file-name (expand-file-name default-directory) nil
- (let ((coding-system-for-read 'utf-8-dos) ; Is this correct?
- (command
+ (setq command
(format
"cd %s && exec %s"
(tramp-unquote-shell-quote-argument localname)
(mapconcat #'tramp-shell-quote-argument (cons program args) " ")))
- input tmpinput stderr tmpstderr outbuf)
-
- ;; Determine input.
- (if (null infile)
- (setq input (tramp-get-remote-null-device v))
- (setq infile (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)))
(unwind-protect
- (apply
- #'tramp-call-process
- v (tramp-get-method-parameter v 'tramp-login-program)
- nil outbuf display
- (tramp-expand-args
- v 'tramp-login-args nil
- ?h (or (tramp-file-name-host v) "")
- ?u (or (tramp-file-name-user v) "")
- ?p (or (tramp-file-name-port v) "")
- ?a "-t" ?l command))
+ (setq ret
+ (apply
+ #'tramp-call-process
+ v (tramp-get-method-parameter v 'tramp-login-program)
+ nil outbuf display
+ (tramp-expand-args
+ v 'tramp-login-args nil
+ ?h (or (tramp-file-name-host v) "")
+ ?u (or (tramp-file-name-user v) "")
+ ?p (or (tramp-file-name-port v) "")
+ ?a "-t" ?l command)))
;; Synchronize stderr.
(when tmpstderr
(tramp-cleanup-connection v 'keep-debug 'keep-password)
- (tramp-fuse-unmount 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 "/"))))))
+ (tramp-fuse-unmount v))))))
(defun tramp-sshfs-handle-rename-file
(filename newname &optional ok-if-already-exists)
(or (tramp-get-connection-property vec "process-name")
(tramp-buffer-name vec)))
+(defun tramp-get-unique-process-name (name)
+ "Return a unique process name, based on NAME."
+ (let ((name1 name)
+ (i 0))
+ (while (get-process name1)
+ ;; NAME must be unique as process name.
+ (setq i (1+ i)
+ name1 (format "%s<%d>" name i)))
+ name1))
+
(defun tramp-get-process (vec-or-proc)
"Get the default connection process to be used for VEC-OR-PROC.
Return `tramp-cache-undefined' in case it doesn't exist."
(signal 'file-error (list "Wrong stderr" stderr)))
(let ((default-directory tramp-compat-temporary-file-directory)
+ (name (tramp-get-unique-process-name name))
(buffer
(if buffer
(get-buffer-create buffer)
,@body)))
+(defmacro tramp-skeleton-process-file
+ (_program &optional infile destination _display _args &rest body)
+ "Skeleton for `tramp-*-handle-process-file'.
+BODY is the backend specific code."
+ (declare (indent 5) (debug t))
+ `(with-parsed-tramp-file-name (expand-file-name default-directory) nil
+ ;; The implementation is not complete yet.
+ (when (and (numberp ,destination) (zerop ,destination))
+ (tramp-error
+ v 'file-error "Implementation does not handle immediate return"))
+
+ (let (command input tmpinput stderr tmpstderr outbuf ret)
+ ;; Determine input.
+ (if (null ,infile)
+ (setq input (tramp-get-remote-null-device v))
+ (setq ,infile (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)))
+
+ ;; 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))))
+
+ ,@body
+
+ ;; 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))))
+
(defcustom tramp-inhibit-errors-if-setting-file-attributes-fail nil
"Whether to warn only if `tramp-*-set-file-{modes,times,uid-gid}' fails."
:version "30.1"
;; 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)
;; <https://www.mail-archive.com/tramp-devel@nongnu.org/msg01041.html>.
;; (Bug#6850)
;;
-;; * Refactor code from different handlers. Start with
-;; *-process-file. One idea is to generalize `tramp-send-command'
-;; and friends, for most of the handlers this is the major
-;; difference between the different backends. Other handlers but
-;; *-process-file would profit from this as well.
-;;
;; * Implement file name abbreviation for a different user. That is,
;; (abbreviate-file-name "/ssh:user1@host:/home/user2") =>
;; "/ssh:user1@host:~user2".
;;
;; * Implement file name abbreviation for user and host names.
;;
-;; * Implement user and host name completion for multi-hops.
+;; * Implement user and host name completion for multi-hops. Some
+;; methods in tramp-container.el have it already.
;;; tramp.el ends here
projects / emacs.git / commitdiff