From: Michael Albinus Date: Tue, 14 Mar 2023 10:38:39 +0000 (+0100) Subject: Improve Tramp processes to accept output over the same socket X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=54ef338ba3670415cf47fabc33a92d4904707c7e;p=emacs.git 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 64f45e7958d..d338201ab72 100644 --- 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 266724c587f..c1ad37de1d2 100644 --- 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 a854ff42b0d..5227897fbec 100644 --- 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 1aa4520eeb6..bb4ab9e3057 100644 --- 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 abb9afc570b..3cacde2468c 100644 --- 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 47173b95bea..b6e985db6b1 100644 --- 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)