From: Michael Albinus Date: Sun, 16 May 2021 10:08:09 +0000 (+0200) Subject: Fix handling of stderr buffer in Tramp's make-process (Bug#47861) X-Git-Tag: emacs-28.0.90~2457 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=4f510f63a8fc3483eeac7887cb69ddfa6de9b5a6;p=emacs.git Fix handling of stderr buffer in Tramp's make-process (Bug#47861) * lisp/net/tramp-sh.el (tramp-sh-handle-make-process): Reimplement stderr buffer handling. (Bug#47861) (tramp-maybe-open-connection): Improve traces. * test/lisp/net/tramp-tests.el (tramp-test30-make-process): Rework for stderr buffer. --- diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 60090d31b88..f24d0effe71 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2723,13 +2723,12 @@ the result will be a local, non-Tramp, file name." ;; 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 @@ -2763,7 +2762,7 @@ alternative implementation will be used." (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))) @@ -2775,9 +2774,9 @@ alternative implementation will be used." ;; 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)) @@ -2786,7 +2785,8 @@ alternative implementation will be used." ;; "-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)) @@ -2850,6 +2850,23 @@ alternative implementation will be used." 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) @@ -2912,38 +2929,16 @@ alternative implementation will be used." (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 - ;; . - (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))) @@ -4834,10 +4829,12 @@ connection if a previous connection has died for some reason." (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))) @@ -5937,8 +5934,6 @@ function cell is returned to be applied on a buffer." ;; 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 diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index a045b9c62f7..5e4626ab41a 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4581,8 +4581,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (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))) @@ -4610,13 +4609,13 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." ;; 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. @@ -4628,7 +4627,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." ;; Cleanup. (ignore-errors (delete-process proc) - (delete-file tmp-name1))) + (delete-file tmp-name))) ;; Process filter. (unwind-protect @@ -4692,11 +4691,17 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." :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))))) @@ -4707,30 +4712,29 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." ;; 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'.")