;; We use BUFFER also as connection buffer during setup. Because of
;; this, its original contents must be saved, and restored once
;; connection has been setup.
-;; The complete STDERR buffer is available only when the process has
-;; terminated.
(defun tramp-sh-handle-make-process (&rest args)
"Like `make-process' for Tramp files.
-STDERR can also be a file name. 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 property
+\"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
(signal 'wrong-type-argument (list #'functionp sentinel)))
(unless (or (null stderr) (bufferp stderr) (stringp stderr))
(signal 'wrong-type-argument (list #'bufferp stderr)))
- (when (and (stringp stderr) (tramp-tramp-file-p stderr)
+ (when (and (stringp stderr)
(not (tramp-equal-remote default-directory stderr)))
(signal 'file-error (list "Wrong stderr" stderr)))
;; 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))))
+ (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)))
(program (car command))
;; "-c", it might be that the arguments exceed the
;; command line length. Therefore, we modify the
;; command.
- (heredoc (and (stringp program)
+ (heredoc (and (not (bufferp stderr))
+ (stringp program)
(string-match-p "sh$" program)
(= (length args) 2)
(string-equal "-c" (car args))
tramp-current-connection
p)
+ ;; Handle error buffer.
+ (when (bufferp stderr)
+ (with-current-buffer stderr
+ (setq buffer-read-only nil))
+ ;; Create named pipe.
+ (tramp-send-command v (format "mknod %s p" 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)
(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))))
- ;; 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.
+ ;; Kill stderr process delete and named pipe.
(when (bufferp stderr)
- (with-current-buffer stderr
- ;; There's a mysterious error, see
- ;; <https://github.com/joaotavora/eglot/issues/662>.
- (ignore-errors
- (insert-file-contents-literally remote-tmpstderr)))
- ;; Delete tmpstderr file.
(add-function
:after (process-sentinel p)
(lambda (_proc _msg)
- (when (file-exists-p remote-tmpstderr)
- (with-current-buffer stderr
- (ignore-errors
- (insert-file-contents-literally
- remote-tmpstderr nil nil nil 'replace)))
+ (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)))
(with-tramp-progress-reporter
vec 3
(if (zerop (length (tramp-file-name-user vec)))
- (format "Opening connection for %s using %s"
+ (format "Opening connection %s for %s using %s"
+ process-name
(tramp-file-name-host vec)
(tramp-file-name-method vec))
- (format "Opening connection for %s@%s using %s"
+ (format "Opening connection %s for %s@%s using %s"
+ process-name
(tramp-file-name-user vec)
(tramp-file-name-host vec)
(tramp-file-name-method vec)))
;; session could be reused after a connection loss. Use dtach, or
;; screen, or tmux, or mosh.
;;
-;; * Implement `:stderr' of `make-process' as pipe process.
-
;; * One interesting solution (with other applications as well) would
;; be to stipulate, as a directory or connection-local variable, an
;; additional rc file on the remote machine that is sourced every
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let ((default-directory tramp-test-temporary-file-directory)
- (tmp-name1 (tramp--test-make-temp-name nil quoted))
- (tmp-name2 (tramp--test-make-temp-name 'local quoted))
+ (tmp-name (tramp--test-make-temp-name nil quoted))
kill-buffer-query-functions proc)
(with-no-warnings (should-not (make-process)))
;; Simple process using a file.
(unwind-protect
(with-temp-buffer
- (write-region "foo" nil tmp-name1)
- (should (file-exists-p tmp-name1))
+ (write-region "foo" nil tmp-name)
+ (should (file-exists-p tmp-name))
(setq proc
(with-no-warnings
(make-process
:name "test2" :buffer (current-buffer)
- :command `("cat" ,(file-name-nondirectory tmp-name1))
+ :command `("cat" ,(file-name-nondirectory tmp-name))
:file-handler t)))
(should (processp proc))
;; Read output.
;; Cleanup.
(ignore-errors
(delete-process proc)
- (delete-file tmp-name1)))
+ (delete-file tmp-name)))
;; Process filter.
(unwind-protect
:stderr stderr
:file-handler t)))
(should (processp proc))
- ;; Read stderr.
+ ;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
(while (accept-process-output proc 0 nil t)))
- (delete-process proc)
+ ;; Read stderr.
(with-current-buffer stderr
+ (with-timeout (10 (tramp--test-timeout-handler))
+ (while (not (string-match-p
+ "No such file or directory" (buffer-string)))
+ (while (accept-process-output
+ (get-buffer-process stderr) 0 nil t))))
+ (delete-process proc)
(should
(string-match-p
"cat:.* No such file or directory" (buffer-string)))))
;; Process with stderr file.
(unless (tramp-direct-async-process-p)
- (dolist (tmpfile `(,tmp-name1 ,tmp-name2))
- (unwind-protect
+ (unwind-protect
+ (with-temp-buffer
+ (setq proc
+ (with-no-warnings
+ (make-process
+ :name "test6" :buffer (current-buffer)
+ :command '("cat" "/does-not-exist")
+ :stderr tmp-name
+ :file-handler t)))
+ (should (processp proc))
+ ;; Read stderr.
+ (with-timeout (10 (tramp--test-timeout-handler))
+ (while (accept-process-output proc nil nil t)))
+ (delete-process proc)
(with-temp-buffer
- (setq proc
- (with-no-warnings
- (make-process
- :name "test6" :buffer (current-buffer)
- :command '("cat" "/does-not-exist")
- :stderr tmpfile
- :file-handler t)))
- (should (processp proc))
- ;; Read stderr.
- (with-timeout (10 (tramp--test-timeout-handler))
- (while (accept-process-output proc nil nil t)))
- (delete-process proc)
- (with-temp-buffer
- (insert-file-contents tmpfile)
- (should
- (string-match-p
- "cat:.* No such file or directory" (buffer-string)))))
+ (insert-file-contents tmp-name)
+ (should
+ (string-match-p
+ "cat:.* No such file or directory" (buffer-string)))))
- ;; Cleanup.
- (ignore-errors (delete-process proc))
- (ignore-errors (delete-file tmpfile))))))))
+ ;; Cleanup.
+ (ignore-errors (delete-process proc))
+ (ignore-errors (delete-file tmp-name)))))))
(tramp--test--deftest-direct-async-process tramp-test30-make-process
"Check direct async `make-process'.")
projects / emacs.git / commitdiff