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.
This commit is contained in:
Michael Albinus 2023-03-14 11:38:39 +01:00
parent b9a70865d2
commit 54ef338ba3
6 changed files with 43 additions and 16 deletions

View file

@ -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

View file

@ -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))

View file

@ -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)))

View file

@ -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))

View file

@ -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)

View file

@ -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)