Adapt accept-process-output timeouts in Tramp

* lisp/net/tramp.el (tramp-accept-process-output):
Make timeout optional.  Do not set explicit timer.
(tramp-action-out-of-band, tramp-process-one-action)
(tramp-wait-for-regexp, tramp-interrupt-process):
* lisp/net/tramp-adb.el (tramp-adb-parse-device-names):
* lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-notify-add-watch):
* lisp/net/tramp-rclone.el (tramp-rclone-parse-device-names):
* 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):
* tramp-sudoedit.el (tramp-sudoedit-action-sudo):
Adapt `accept-process-output' calls wrt timeouts.
This commit is contained in:
Michael Albinus 2019-01-28 16:33:27 +01:00
parent cd06d173a6
commit 6c560a3b16
7 changed files with 21 additions and 29 deletions

View file

@ -206,8 +206,7 @@ pass to the OPERATION."
(tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " "))
(process-put p 'adjust-window-size-function 'ignore)
(set-process-query-on-exit-flag p nil)
(while (or (accept-process-output p 0.1)
(process-live-p p)))
(while (accept-process-output p nil nil t))
(tramp-message v 6 "\n%s" (buffer-string))
(goto-char (point-min))
(while (search-forward-regexp "^\\(\\S-+\\)[[:space:]]+device$" nil t)

View file

@ -1186,7 +1186,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(set-process-filter p 'tramp-gvfs-monitor-process-filter)
;; There might be an error if the monitor is not supported.
;; Give the filter a chance to read the output.
(tramp-accept-process-output p 1)
(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

@ -183,8 +183,7 @@ pass to the OPERATION."
(tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " "))
(process-put p 'adjust-window-size-function 'ignore)
(set-process-query-on-exit-flag p nil)
(while (or (accept-process-output p 0.1)
(process-live-p p)))
(while (accept-process-output p nil nil t))
(tramp-message v 6 "\n%s" (buffer-string))
(goto-char (point-min))
(while (search-forward-regexp "^\\(\\S-+\\):$" nil t)

View file

@ -3647,7 +3647,7 @@ Fall back to normal file name handler if no Tramp handler exists."
(set-process-filter p filter)
;; There might be an error if the monitor is not supported.
;; Give the filter a chance to read the output.
(tramp-accept-process-output p 1)
(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

@ -721,7 +721,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.1))
(while (tramp-accept-process-output proc))
(with-current-buffer (tramp-get-connection-buffer vec)
;; There might be a hidden password prompt.
(widen)
@ -1374,10 +1374,10 @@ component is used as the target of the symlink."
(delete-file filename)))))
(defun tramp-smb-action-set-acl (proc vec)
"Read ACL data from connection buffer."
"Set ACL data."
(unless (process-live-p proc)
;; Accept pending output.
(while (tramp-accept-process-output proc 0.1))
(while (tramp-accept-process-output proc))
(with-current-buffer (tramp-get-connection-buffer vec)
(tramp-message vec 10 "\n%s" (buffer-string))
(throw 'tramp-action 'ok))))
@ -2043,10 +2043,8 @@ Removes smb prompt. Returns nil if an error message has appeared."
(inhibit-read-only t))
;; Read pending output.
(goto-char (point-min))
(while (not (or (re-search-forward tramp-smb-prompt nil t)
(re-search-forward tramp-smb-errors nil t)))
(while (tramp-accept-process-output p 0.1)
(while (not (re-search-forward tramp-smb-prompt nil t))
(while (tramp-accept-process-output p 0)
(goto-char (point-min))))
(tramp-message vec 6 "\n%s" (buffer-string))

View file

@ -747,8 +747,8 @@ 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.
(while (tramp-accept-process-output proc 0.1))
(when (not (process-live-p proc))
(while (tramp-accept-process-output proc 0))
;; Delete narrowed region, it would be in the way reading a Lisp form.
(goto-char (point-min))
(widen)

View file

@ -3977,7 +3977,7 @@ The terminal type can be configured with `tramp-terminal-type'."
(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.1))
(while (tramp-accept-process-output proc 0))
(cond ((and (not (process-live-p proc))
(zerop (process-exit-status proc)))
(tramp-message vec 3 "Process has finished.")
@ -4007,7 +4007,7 @@ The terminal type can be configured with `tramp-terminal-type'."
(while (not found)
;; Reread output once all actions have been performed.
;; Obviously, the output was not complete.
(tramp-accept-process-output proc 1)
(while (tramp-accept-process-output proc 0))
(setq todo actions)
(while todo
(setq item (pop todo))
@ -4078,7 +4078,7 @@ connection buffer."
;;; Utility functions:
(defun tramp-accept-process-output (proc 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."
@ -4088,15 +4088,12 @@ for process communication also."
;; We do not want to run timers.
timer-list timer-idle-list
result)
;; Under Windows XP, `accept-process-output' doesn't return
;; sometimes. So we add an additional timeout. JUST-THIS-ONE
;; is set due to Bug#12145. It is an integer, in order to avoid
;; running timers as well.
;; JUST-THIS-ONE is set due to Bug#12145. It is an integer, in
;; order to avoid running timers.
(tramp-message
proc 10 "%s %s %s\n%s"
proc (process-status proc)
(setq result (with-timeout (timeout)
(accept-process-output proc timeout nil 0)))
proc 10 "%s %s %s %s\n%s"
proc timeout (process-status proc)
(setq result (accept-process-output proc timeout nil 0))
(buffer-string))
result)))
@ -4146,14 +4143,14 @@ nil."
(cond (timeout
(with-timeout (timeout)
(while (not found)
(tramp-accept-process-output proc 1)
(tramp-accept-process-output proc)
(unless (process-live-p proc)
(tramp-error-with-buffer
nil proc 'file-error "Process has died"))
(setq found (tramp-check-for-regexp proc regexp)))))
(t
(while (not found)
(tramp-accept-process-output proc 1)
(tramp-accept-process-output proc)
(unless (process-live-p proc)
(tramp-error-with-buffer
nil proc 'file-error "Process has died"))
@ -4831,8 +4828,7 @@ Only works for Bourne-like shells."
;; fall back to the default implementation.
(with-timeout (1 (ignore))
;; We cannot run `tramp-accept-process-output', it blocks timers.
(while (or (accept-process-output proc 0.1)
(process-live-p proc)))
(while (accept-process-output proc nil nil t))
;; Report success.
proc)))))