From: Michael Albinus Date: Wed, 16 Jan 2019 12:56:38 +0000 (+0100) Subject: Some accept-process-output cleanups in Tramp X-Git-Tag: emacs-27.0.90~3817 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b2497ef6952134022ad799247bc5a31f7559ef87;p=emacs.git Some accept-process-output cleanups in Tramp * 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. --- diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index ca47601e4bd..0a357e1ae2f 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -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) diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 73660572966..f5d184af698 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -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) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 134ae7a201e..022ecb3d790 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -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 diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index abf3248a353..8198930abc6 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -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." diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index e1e5ab091a1..ff3a7d79132 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -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)) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 7632d656a0f..3b235095d37 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -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. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index ff63dc18fbc..28935062864 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -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))