...
 
Commits (2)
  • Michael Albinus's avatar
    Adapt accept-process-output timeouts in Tramp · 6c560a3b
    Michael Albinus authored
    * 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.
    6c560a3b
  • Michael Albinus's avatar
......@@ -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)
......
......@@ -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))
......
......@@ -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)
......
......@@ -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))
......
......@@ -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))
......
......@@ -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)
......
......@@ -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)))))
......
......@@ -1817,17 +1817,15 @@ properly. BODY shall not contain a timeout."
(should (string-equal (file-remote-p "/-:ftp.host:" 'method) "ftp"))
(dolist (u '("ftp" "anonymous"))
(should (string-equal (file-remote-p (format "/-:%s@:" u) 'method) "ftp")))
;; Default values in tramp-gvfs.el.
(when (and (load "tramp-gvfs" 'noerror 'nomessage)
(symbol-value 'tramp-gvfs-enabled))
(should (string-equal (file-remote-p "/synce::" 'user) nil)))
;; Default values in tramp-sh.el.
;; Default values in tramp-sh.el and tramp-sudoedit.el.
(dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name)))
(should
(string-equal (file-remote-p (format "/-:root@%s:" h) 'method) "su")))
(dolist (m '("su" "sudo" "ksu"))
(should (string-equal (file-remote-p (format "/%s::" m) 'user) "root")))
(dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp"))
(dolist (m '("su" "sudo" "ksu" "doas" "sudoedit"))
(should (string-equal (file-remote-p (format "/%s::" m) 'user) "root"))
(should
(string-equal (file-remote-p (format "/%s::" m) 'host) (system-name))))
(dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp" "nc"))
(should
(string-equal (file-remote-p (format "/%s::" m) 'user) (user-login-name))))
;; Default values in tramp-smb.el.
......