mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-29 07:58:28 +00:00
Code Issues Releases Activity

Some accept-process-output cleanups in Tramp

Browse Source 
* lisp/net/tramp.el (tramp-action-out-of-band): Read process
output in a loop.
(tramp-accept-process-output): Return result.
(tramp-interrupt-process):
* lisp/net/tramp-adb.el (tramp-adb-parse-device-names):
* lisp/net/tramp-rclone.el (tramp-rclone-parse-device-names):
Remove FIXME.

* lisp/net/tramp-sh.el (tramp-local-coding-commands): Fix docstring.

* lisp/net/tramp-smb.el (tramp-smb-wait-for-output): Adapt docstring.
Simplify code.

* lisp/net/tramp-sudoedit.el (tramp-sudoedit-action-sudo):
Adapt docstring.  Read process output in a loop.

* test/lisp/net/tramp-tests.el (tramp-test43-asynchronous-requests):
Remove :unstable tag on emba.
This commit is contained in:
Michael Albinus 2019-01-16 13:56:38 +01:00
parent 02976d6736
commit b2497ef695
7 changed files with 41 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lisp/net/tramp-adb.el
View File

@ -206,7 +206,6 @@ 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)
;; FIXME: Either remove " 0.1", or comment why it's needed.
(while (or (accept-process-output p 0.1)
(process-live-p p)))
(tramp-message v 6 "\n%s" (buffer-string))
@ -471,7 +470,7 @@ Convert (\"-al\") to (\"-a\" \"-l\"). Remove arguments like \"--dired\"."
(apply 'concat
(mapcar (lambda (s)
(replace-regexp-in-string
"\\(.\\)" " -\\1" (replace-regexp-in-string "^-" "" s)))
"\\(.\\)" " -\\1" (replace-regexp-in-string "^-" "" s)))
;; FIXME: Warning about removed switches (long and non-dash).
(delq nil
(mapcar
@ -590,7 +589,7 @@ Emacs dired can't find files."
(delq
nil
(mapcar
(lambda (l) (and (not (string-match-p "^[[:space:]]*$" l)) l))
(lambda (l) (and (not (string-match-p "^[[:space:]]*$" l)) l))
(split-string (buffer-string) "\n")))))))))))
(defun tramp-adb-handle-file-local-copy (filename)
@ -1327,7 +1326,7 @@ connection if a previous connection has died for some reason."
;; Wait for initial prompt.
(tramp-adb-wait-for-output p 30)
(unless (process-live-p p)
(tramp-error vec 'file-error "Terminated!"))
(tramp-error vec 'file-error "Terminated!"))
(process-put p 'vector vec)
(process-put p 'adjust-window-size-function 'ignore)
(set-process-query-on-exit-flag p nil)

3
lisp/net/tramp-rclone.el
View File

@ -183,7 +183,6 @@ 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)
;; FIXME: Either remove " 0.1", or comment why it's needed.
(while (or (accept-process-output p 0.1)
(process-live-p p)))
(tramp-message v 6 "\n%s" (buffer-string))
@ -461,7 +460,7 @@ file names."
(expand-file-name
(concat
tramp-temp-name-prefix (tramp-file-name-method vec)
"." (tramp-file-name-host vec))
"." (tramp-file-name-host vec))
(tramp-compat-temporary-file-directory)))
(defun tramp-rclone-mounted-p (vec)

8
lisp/net/tramp-sh.el
View File

@ -4340,7 +4340,7 @@ Each item is a list that looks like this:
\(FORMAT ENCODING DECODING)
FORMAT is symbol describing the encoding/decoding format. It can be
FORMAT is a symbol describing the encoding/decoding format. It can be
`b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing.
ENCODING and DECODING can be strings, giving commands, or symbols,
@ -4722,7 +4722,7 @@ Goes through the list `tramp-inline-compress-commands'."
(ignore-errors
(when (executable-find "ssh")
(with-tramp-progress-reporter
vec 4 "Computing ControlMaster options"
vec 4 "Computing ControlMaster options"
(with-temp-buffer
(tramp-call-process vec "ssh" nil t nil "-o" "ControlMaster")
(goto-char (point-min))
@ -5933,5 +5933,9 @@ function cell is returned to be applied on a buffer."
;; which could immediately be passed on to the remote side, and
;; later on checks the return value of those calls as and when
;; needed. (Stefan Monnier)
;;
;; * Implement detaching/re-attaching remote sessions. By this, a
;; session could be reused after a connection loss. Use dtach, or
;; screen, or tmux, or mosh.
;;; tramp-sh.el ends here

45
lisp/net/tramp-smb.el
View File

@ -1087,7 +1087,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; Half a year.
(time-since (nth 3 x)) (days-to-time 183))
"%b %e %R"
"%b %e %Y")
"%b %e %Y")
(nth 3 x))))) ; date
;; We mark the file name. The inserted name could be
@ -2026,54 +2026,25 @@ If ARGUMENT is non-nil, use it as argument for
;; We don't use timeouts. If needed, the caller shall wrap around.
(defun tramp-smb-wait-for-output (vec)
"Wait for output from smbclient command.
Returns nil if an error message has appeared."
Removes smb prompt. Returns nil if an error message has appeared."
(with-current-buffer (tramp-get-connection-buffer vec)
(let ((p (get-buffer-process (current-buffer)))
(found (progn (goto-char (point-min))
(re-search-forward tramp-smb-prompt nil t)))
(err (progn (goto-char (point-min))
(re-search-forward tramp-smb-errors nil t)))
buffer-read-only)
;; Algorithm: get waiting output. See if last line contains
;; `tramp-smb-prompt' sentinel or `tramp-smb-errors' strings.
;; If not, wait a bit and again get waiting output.
;; FIXME: Either remove " 0.1", or comment why it's needed.
(while (and (not found) (not err)
(or (tramp-accept-process-output p 0.1)
(process-live-p p)))
;; Search for prompt.
(goto-char (point-min))
(setq found (re-search-forward tramp-smb-prompt nil t))
;; Search for errors.
(goto-char (point-min))
(setq err (re-search-forward tramp-smb-errors nil t)))
;; When the process is still alive, read pending output.
;; FIXME: This loop should be folded into the previous loop.
;; Also, ERR should be set just once, after the combined
;; loop has finished.
;; FIXME: Either remove " 0.1", or comment why it's needed.
(while (and (not found)
(or (tramp-accept-process-output p 0.1)
(process-live-p p)))
;; Search for prompt.
(goto-char (point-min))
(setq found (re-search-forward tramp-smb-prompt nil t)))
;; Read pending output.
(while (tramp-accept-process-output p 0.1))
(tramp-message vec 6 "\n%s" (buffer-string))
;; Remove prompt.
(when found
(goto-char (point-min))
(when (re-search-forward tramp-smb-prompt nil t)
(goto-char (point-max))
(re-search-backward tramp-smb-prompt nil t)
(delete-region (point) (point-max)))
;; Return value is whether no error message has appeared.
(not err))))
(goto-char (point-min))
(not (re-search-forward tramp-smb-errors nil t)))))
(defun tramp-smb-kill-winexe-function ()
"Send SIGKILL to the winexe process."

7
lisp/net/tramp-sudoedit.el
View File

@ -744,11 +744,10 @@ ID-FORMAT valid values are `string' and `integer'."
;; Used in `tramp-sudoedit-sudo-actions'.
(defun tramp-sudoedit-action-sudo (proc vec)
"Check, whether a sudo process copy has finished."
"Check, whether a sudo process has finished.
Remove unneeded output."
;; There might be pending output for the exit status.
;; FIXME: Either remove " 0.1", or comment why it's needed.
;; FIXME: There's a race here. Shouldn't the next two lines be interchanged?
(tramp-accept-process-output proc 0.1)
(while (tramp-accept-process-output proc 0.1))
(when (not (process-live-p proc))
;; Delete narrowed region, it would be in the way reading a Lisp form.
(goto-char (point-min))

21
lisp/net/tramp.el
View File

@ -3457,7 +3457,7 @@ User is always nil."
start
(or (text-property-any start (point-at-eol) 'dired-filename t)
(point-at-eol)))
(if (= (point-at-bol) (point-at-eol))
(if (= (point-at-bol) (point-at-eol))
;; Empty line.
(delete-region (point) (progn (forward-line) (point)))
(forward-line)))))))))
@ -3977,9 +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.
;; FIXME: Either remove " 0.1", or comment why it's needed.
;; FIXME: Shouldn't the following line be wrapped inside (while ...)?
(tramp-accept-process-output proc 0.1)
(while (tramp-accept-process-output proc 0.1))
(cond ((and (not (process-live-p proc))
(zerop (process-exit-status proc)))
(tramp-message vec 3 "Process has finished.")
@ -4087,7 +4085,8 @@ for process communication also."
(with-current-buffer (process-buffer proc)
(let (buffer-read-only last-coding-system-used
;; We do not want to run timers.
timer-list timer-idle-list)
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
@ -4095,9 +4094,10 @@ for process communication also."
(tramp-message
proc 10 "%s %s %s\n%s"
proc (process-status proc)
(with-timeout (timeout)
(accept-process-output proc timeout nil 0))
(buffer-string)))))
(setq result (with-timeout (timeout)
(accept-process-output proc timeout nil 0)))
(buffer-string))
result)))
(defun tramp-check-for-regexp (proc regexp)
"Check, whether REGEXP is contained in process buffer of PROC.
@ -4641,7 +4641,7 @@ are written with verbosity of 6."
It always returns a return code. The Lisp error raised when
PROGRAM is nil is trapped also, returning 1. Furthermore, traces
are written with verbosity of 6."
(let ((default-directory (tramp-compat-temporary-file-directory))
(let ((default-directory (tramp-compat-temporary-file-directory))
(buffer (if (eq buffer t) (current-buffer) buffer))
result)
(tramp-message
@ -4812,7 +4812,7 @@ Only works for Bourne-like shells."
pid)
;; If it's a Tramp process, send the INT signal remotely.
(when (and (processp proc) (setq pid (process-get proc 'remote-pid)))
(if (not (process-live-p proc))
(if (not (process-live-p proc))
(tramp-error proc 'error "Process %s is not active" proc)
(tramp-message proc 5 "Interrupt process %s with pid %s" proc pid)
;; This is for tramp-sh.el. Other backends do not support this (yet).
@ -4824,7 +4824,6 @@ 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.
;; FIXME: Either remove " 0.1", or comment why it's needed.
(while (or (accept-process-output proc 0.1)
(process-live-p proc)))
;; Report success.

14
test/lisp/net/tramp-tests.el
View File

@ -405,7 +405,7 @@ handled properly. BODY shall not contain a timeout."
tramp-default-user-alist
tramp-default-host-alist
;; Suppress check for multihops.
(tramp-cache-data (make-hash-table :test 'equal))
(tramp-cache-data (make-hash-table :test 'equal))
(tramp-connection-properties '((nil "login-program" t))))
;; Expand `tramp-default-user' and `tramp-default-host'.
(should (string-equal
@ -844,7 +844,7 @@ handled properly. BODY shall not contain a timeout."
tramp-default-user-alist
tramp-default-host-alist
;; Suppress check for multihops.
(tramp-cache-data (make-hash-table :test 'equal))
(tramp-cache-data (make-hash-table :test 'equal))
(tramp-connection-properties '((nil "login-program" t)))
(syntax tramp-syntax))
(unwind-protect
@ -1168,7 +1168,7 @@ handled properly. BODY shall not contain a timeout."
tramp-default-user-alist
tramp-default-host-alist
;; Suppress check for multihops.
(tramp-cache-data (make-hash-table :test 'equal))
(tramp-cache-data (make-hash-table :test 'equal))
(tramp-connection-properties '((nil "login-program" t)))
(syntax tramp-syntax))
(unwind-protect
@ -5212,7 +5212,13 @@ Use the `ls' command."
"Check parallel asynchronous requests.
Such requests could arrive from timers, process filters and
process sentinels. They shall not disturb each other."
:tags '(:expensive-test :unstable)
;; The test fails from time to time, w/o a reproducible pattern. So
;; we mark it as unstable.
;; Recent investigations have uncovered a race condition in
;; `accept-process-output'. Let's check on emba, whether this has
;; been solved.
:tags
(if (getenv "EMACS_EMBA_CI") '(:expensive-test) '(:expensive-test :unstable))
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))