master 4f510f6: Fix handling of stderr buffer in Tramp's make-process (Bug#47861)

[Michael Albinus]

branch: master
commit 4f510f63a8fc3483eeac7887cb69ddfa6de9b5a6
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    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.
---
 lisp/net/tramp-sh.el         | 79 +++++++++++++++++++++-----------------------
 test/lisp/net/tramp-tests.el | 64 ++++++++++++++++++-----------------
 2 files changed, 71 insertions(+), 72 deletions(-)

diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 60090d3..f24d0ef 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
-                           ;; <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)))
@@ -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 a045b9c..5e4626a 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'.")