Improve Tramp processes to accept output over the same socket

* lisp/net/tramp.el (tramp-accept-process-output): Don't use TIMEOUT
anymore, default it to 0.  When the connection uses a shared
socket possibly, accept also the output from other processes over
the same connection.  (Bug#61350)
(tramp-handle-file-notify-rm-watch, tramp-action-process-alive)
(tramp-action-out-of-band, tramp-process-one-action)
(tramp-interrupt-process):
* lisp/net/tramp-adb.el (tramp-adb-handle-make-process):
* lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-notify-add-watch):
* lisp/net/tramp-sh.el (tramp-sh-handle-file-notify-add-watch):
* lisp/net/tramp-smb.el (tramp-smb-action-get-acl)
(tramp-smb-action-set-acl, tramp-smb-wait-for-output):
* lisp/net/tramp-sudoedit.el (tramp-sudoedit-action-sudo):
Adapt callees.

* lisp/net/tramp.el (tramp-handle-make-process):
* lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band)
(tramp-sh-handle-file-notify-add-watch)
(tramp-maybe-open-connection): Set `shared-socket' property.

diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 64f45e7958d24294f031162953e76deeef130ebd..d338201ab723cbf138aa9d6c449543e3362ebbda 100644 (file)
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -990,7 +990,7 @@ implementation will be used."
                                  (progn
                                    (goto-char (point-min))
                                    (not (search-forward "\n" nil t)))
-                               (tramp-accept-process-output p 0))
+                               (tramp-accept-process-output p))
                              (delete-region (point-min) (point)))
                            ;; Provide error buffer.  This shows only
                            ;; initial error messages; messages

diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 266724c587fb612c85e0222817e577546af41078..c1ad37de1d2295973bc47111562d176265a5112f 100644 (file)
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1469,7 +1469,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
        (set-process-sentinel p #'tramp-file-notify-process-sentinel)
        ;; There might be an error if the monitor is not supported.
        ;; Give the filter a chance to read the output.
-       (while (tramp-accept-process-output p 0))
+       (while (tramp-accept-process-output p))
        (unless (process-live-p p)
          (tramp-error
           p 'file-notify-error "Monitoring not supported for `%s'" file-name))

diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index a854ff42b0d5b6ef86977d64d89a2223c54cf1d7..5227897fbec5bd4b6ec62e9e62cd67c42a45fb65 100644 (file)
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2424,6 +2424,10 @@ The method used must be an out-of-band method."
                      copy-program copy-args)))
                (tramp-message v 6 "%s" (string-join (process-command p) " "))
                (process-put p 'vector v)
+               ;; This is neded 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 'shared-socket t)
                (process-put p 'adjust-window-size-function #'ignore)
                (set-process-query-on-exit-flag p nil)
 
@@ -3753,6 +3757,10 @@ Fall back to normal file name handler if no Tramp handler exists."
           (string-join sequence " "))
        (tramp-message v 6 "Run `%s', %S" (string-join sequence " ") p)
        (process-put p 'vector v)
+       ;; This is neded 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 'shared-socket t)
        ;; Needed for process filter.
        (process-put p 'events events)
        (process-put p 'watch-name localname)
@@ -3761,7 +3769,7 @@ Fall back to normal file name handler if no Tramp handler exists."
        (set-process-sentinel p #'tramp-file-notify-process-sentinel)
        ;; There might be an error if the monitor is not supported.
        ;; Give the filter a chance to read the output.
-       (while (tramp-accept-process-output p 0))
+       (while (tramp-accept-process-output p))
        (unless (process-live-p p)
          (tramp-error
           p 'file-notify-error "Monitoring not supported for `%s'" file-name))
@@ -5116,6 +5124,10 @@ connection if a previous connection has died for some reason."
                ;; Set sentinel and query flag.  Initialize variables.
                (set-process-sentinel p #'tramp-process-sentinel)
                (process-put p 'vector vec)
+               ;; This is neded 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 'shared-socket t)
                (process-put p 'adjust-window-size-function #'ignore)
                (set-process-query-on-exit-flag p nil)
                (setq tramp-current-connection (cons vec (current-time)))

diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 1aa4520eeb66a52bbc6371a6a33ed8e0c7339bf8..bb4ab9e305703deb8e86c22a74352bc3d573db22 100644 (file)
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -757,7 +757,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
   "Read ACL data from connection buffer."
   (unless (process-live-p proc)
     ;; Accept pending output.
-    (while (tramp-accept-process-output proc 0))
+    (while (tramp-accept-process-output proc))
     (with-current-buffer (tramp-get-connection-buffer vec)
       ;; There might be a hidden password prompt.
       (widen)
@@ -1363,7 +1363,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
   "Set ACL data."
   (unless (process-live-p proc)
     ;; Accept pending output.
-    (while (tramp-accept-process-output proc 0))
+    (while (tramp-accept-process-output proc))
     (tramp-message
      vec 10 "\n%s" (tramp-get-buffer-string (tramp-get-connection-buffer vec)))
     (throw 'tramp-action 'ok)))
@@ -2023,7 +2023,7 @@ Removes smb prompt.  Returns nil if an error message has appeared."
 
       ;; Read pending output.
       (while (not (re-search-forward tramp-smb-prompt nil t))
-       (while (tramp-accept-process-output p 0))
+       (while (tramp-accept-process-output p))
        (goto-char (point-min)))
       (tramp-message vec 6 "\n%s" (buffer-string))
 

diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index abb9afc570bc263f4a8373942082b42540e80c24..3cacde2468cc6892a4f69450f46fc6c681453aa5 100644 (file)
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -692,7 +692,7 @@ ID-FORMAT valid values are `string' and `integer'."
   "Check, whether a sudo process has finished.  Remove unneeded output."
   ;; There might be pending output for the exit status.
   (unless (process-live-p proc)
-    (while (tramp-accept-process-output proc 0))
+    (while (tramp-accept-process-output proc))
     ;; Delete narrowed region, it would be in the way reading a Lisp form.
     (goto-char (point-min))
     (widen)

diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 47173b95beaa233075e0691a4e96f49854b753f3..b6e985db6b111b79b085d641157e663757edbde5 100644 (file)
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -5087,6 +5087,11 @@ substitution.  SPEC-LIST is a list of char/value pairs used for
            ;; t.  See Bug#51177.
            (when filter
              (set-process-filter p filter))
+           (process-put p 'vector v)
+           ;; This is neded 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 'shared-socket t)
            (process-put p 'remote-command orig-command)
            (tramp-set-connection-property p "remote-command" orig-command)
 
@@ -5489,7 +5494,7 @@ of."
   ;; There might be pending output.  Avoid problems with reentrant
   ;; call of Tramp.
   (ignore-errors
-    (while (tramp-accept-process-output proc 0)))
+    (while (tramp-accept-process-output proc)))
   (tramp-message proc 6 "Kill %S" proc)
   (delete-process proc))
 
@@ -5641,13 +5646,13 @@ Wait, until the connection buffer changes."
   "Check, whether a process has finished."
   (unless (process-live-p proc)
     ;; There might be pending output.
-    (while (tramp-accept-process-output proc 0))
+    (while (tramp-accept-process-output proc))
     (throw 'tramp-action 'process-died)))
 
 (defun tramp-action-out-of-band (proc vec)
   "Check, whether an out-of-band copy has finished."
   ;; There might be pending output for the exit status.
-  (while (tramp-accept-process-output proc 0))
+  (while (tramp-accept-process-output proc))
   (cond ((and (not (process-live-p proc))
              (zerop (process-exit-status proc)))
         (tramp-message vec 3 "Process has finished.")
@@ -5678,7 +5683,7 @@ See `tramp-process-actions' for the format of ACTIONS."
     (while (not found)
       ;; Reread output once all actions have been performed.
       ;; Obviously, the output was not complete.
-      (while (tramp-accept-process-output proc 0))
+      (while (tramp-accept-process-output proc))
       (setq todo actions)
       (while todo
        (setq item (pop todo)
@@ -5795,11 +5800,21 @@ Mostly useful to protect BODY from being interrupted by timers."
           ,@body)
        (tramp-flush-connection-property ,proc "locked"))))
 
-(defun tramp-accept-process-output (proc &optional timeout)
+(defun tramp-accept-process-output (proc &optional _timeout)
   "Like `accept-process-output' for Tramp processes.
 This is needed in order to hide `last-coding-system-used', which is set
 for process communication also.
 If the user quits via `C-g', it is propagated up to `tramp-file-name-handler'."
+  (declare (advertised-calling-convention (proc) "29.2"))
+  ;; There could be other processes which use the same socket for
+  ;; communication.  This could block the output for the current
+  ;; process.  Read such output first.  (Bug#61350)
+  (when-let (((process-get proc 'shared-socket))
+            (v (process-get proc 'vector)))
+    (dolist (p (delq proc (process-list)))
+      (when (tramp-file-name-equal-p v (process-get p 'vector))
+       (accept-process-output p 0 nil t))))
+
   (with-current-buffer (process-buffer proc)
     (let ((inhibit-read-only t)
          last-coding-system-used
@@ -5809,10 +5824,10 @@ If the user quits via `C-g', it is propagated up to `tramp-file-name-handler'."
        ;; JUST-THIS-ONE is set due to Bug#12145.  `with-local-quit'
        ;; returns t in order to report success.
        (if (with-local-quit
-             (setq result (accept-process-output proc timeout nil t)) t)
+             (setq result (accept-process-output proc 0 nil t)) t)
            (tramp-message
-            proc 10 "%s %s %s %s\n%s"
-            proc timeout (process-status proc) result (buffer-string))
+            proc 10 "%s %s %s\n%s"
+            proc (process-status proc) result (buffer-string))
          ;; Propagate quit.
          (keyboard-quit)))
       result)))
@@ -6825,7 +6840,7 @@ name of a process or buffer, or nil to default to the current buffer."
                  (tramp-get-remote-null-device (process-get proc 'vector))))
        ;; Wait, until the process has disappeared.  If it doesn't,
        ;; fall back to the default implementation.
-        (while (tramp-accept-process-output proc 0))
+        (while (tramp-accept-process-output proc))
        (not (process-live-p proc))))))
 
 (add-hook 'interrupt-process-functions #'tramp-interrupt-process)