Commit 8147d3c2 authored by Michael Albinus's avatar Michael Albinus

Work on asynchronous processes for tramp-adb.el

* lisp/net/tramp-adb.el (tramp-adb-handle-make-process):
Simplify.  Remove echoed first line.
(tramp-adb-send-command): Add NEVEROPEN and NOOUTPUT.

* lisp/net/tramp-sh.el (tramp-process-sentinel): Remove.
(tramp-sh-handle-make-process): Simplify.

* lisp/net/tramp.el (tramp-process-sentinel): New defun, taken from
tramp-sh.el.  Delete trailing shell prompt.

* test/lisp/net/tramp-tests.el (tramp-test29-start-file-process)
(tramp-test30-make-process): Run also for tramp-adb.
(tramp-test32-shell-command): Remove tramp-adb restrictions.
(tramp-test34-explicit-shell-file-name): Rework.  Remove :unstable tag.
parent ce9490cb
Pipeline #1154 failed with stage
in 60 minutes and 1 second
......@@ -968,7 +968,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(program (car command))
(args (cdr command))
(command
(format "cd %s; %s"
(format "cd %s && exec %s"
(tramp-shell-quote-argument localname)
(mapconcat #'tramp-shell-quote-argument
(cons program args) " ")))
......@@ -1000,24 +1000,16 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; otherwise we might be interrupted by
;; `verify-visited-file-modtime'.
(let ((buffer-undo-list t)
(inhibit-read-only t)
(mark (point)))
(inhibit-read-only t))
(clear-visited-file-modtime)
(narrow-to-region (point-max) (point-max))
;; We call `tramp-adb-maybe-open-connection', in
;; order to cleanup the prompt afterwards.
(tramp-adb-maybe-open-connection v)
(widen)
(delete-region mark (point-max))
(narrow-to-region (point-max) (point-max))
(delete-region (point-min) (point-max))
;; Send the command.
(let* ((p (tramp-get-connection-process v))
(prompt
(tramp-get-connection-property p "prompt" nil)))
(tramp-set-connection-property
p "prompt" (regexp-quote command))
(tramp-adb-send-command v command)
(tramp-set-connection-property p "prompt" prompt)
(let* ((p (tramp-get-connection-process v)))
(tramp-adb-send-command v command nil t) ; nooutput
;; Stop process if indicated.
(when stop
(stop-process p))
......@@ -1032,6 +1024,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(ignore-errors
(set-process-query-on-exit-flag p (null noquery))
(set-marker (process-mark p) (point)))
;; Read initial output. Remove the first line,
;; which is the command echo.
(while
(progn
(goto-char (point-min))
(not (re-search-forward "[\n]" nil t)))
(tramp-accept-process-output p 0))
(delete-region (point-min) (point))
;; Return process.
p))))
......@@ -1119,26 +1119,27 @@ This happens for Android >= 4.0."
;; Connection functions
(defun tramp-adb-send-command (vec command)
(defun tramp-adb-send-command (vec command &optional neveropen nooutput)
"Send the COMMAND to connection VEC."
(tramp-adb-maybe-open-connection vec)
(unless neveropen (tramp-adb-maybe-open-connection vec))
(tramp-message vec 6 "%s" command)
(tramp-send-string vec command)
;; FIXME: Race condition.
(tramp-adb-wait-for-output (tramp-get-connection-process vec))
(with-current-buffer (tramp-get-connection-buffer vec)
(save-excursion
(goto-char (point-min))
;; We can't use stty to disable echo of command. stty is said
;; to be added to toybox 0.7.6. busybox shall have it, but this
;; isn't used any longer for Android.
(delete-matching-lines (regexp-quote command))
;; When the local machine is W32, there are still trailing ^M.
;; There must be a better solution by setting the correct coding
;; system, but this requires changes in core Tramp.
(goto-char (point-min))
(while (re-search-forward "\r+$" nil t)
(replace-match "" nil nil)))))
(unless nooutput
;; FIXME: Race condition.
(tramp-adb-wait-for-output (tramp-get-connection-process vec))
(with-current-buffer (tramp-get-connection-buffer vec)
(save-excursion
(goto-char (point-min))
;; We can't use stty to disable echo of command. stty is said
;; to be added to toybox 0.7.6. busybox shall have it, but this
;; isn't used any longer for Android.
(delete-matching-lines (regexp-quote command))
;; When the local machine is W32, there are still trailing ^M.
;; There must be a better solution by setting the correct coding
;; system, but this requires changes in core Tramp.
(goto-char (point-min))
(while (re-search-forward "\r+$" nil t)
(replace-match "" nil nil))))))
(defun tramp-adb-send-command-and-check (vec command)
"Run COMMAND and check its exit status.
......@@ -1245,6 +1246,9 @@ connection if a previous connection has died for some reason."
(tramp-adb-wait-for-output p 30)
(unless (process-live-p p)
(tramp-error vec 'file-error "Terminated!"))
;; Set sentinel and query flag. Initialize variables.
(set-process-sentinel p #'tramp-process-sentinel)
(process-put p 'vector vec)
(process-put p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil)
......
......@@ -2769,15 +2769,6 @@ the result will be a local, non-Tramp, file name."
;;; Remote commands:
(defun tramp-process-sentinel (proc event)
"Flush file caches."
(unless (process-live-p proc)
(let ((vec (process-get proc 'vector)))
(when vec
(tramp-message vec 5 "Sentinel called: `%S' `%s'" proc event)
(tramp-flush-connection-properties proc)
(tramp-flush-directory-properties vec "")))))
;; We use BUFFER also as connection buffer during setup. Because of
;; this, its original contents must be saved, and restored once
;; connection has been setup.
......@@ -2912,8 +2903,7 @@ the result will be a local, non-Tramp, file name."
;; otherwise we might be interrupted by
;; `verify-visited-file-modtime'.
(let ((buffer-undo-list t)
(inhibit-read-only t)
(mark (point-max)))
(inhibit-read-only t))
(clear-visited-file-modtime)
(narrow-to-region (point-max) (point-max))
;; We call `tramp-maybe-open-connection', in
......@@ -2926,9 +2916,7 @@ the result will be a local, non-Tramp, file name."
(let ((pid (tramp-send-command-and-read v "echo $$")))
(process-put p 'remote-pid pid)
(tramp-set-connection-property p "remote-pid" pid))
(widen)
(delete-region mark (point-max))
(narrow-to-region (point-max) (point-max))
(delete-region (point-min) (point-max))
;; Now do it.
(if command
;; Send the command.
......
......@@ -4212,6 +4212,19 @@ the remote host use line-endings as defined in the variable
;; Reenable the timers.
(with-timeout-unsuspend stimers))))
(defun tramp-process-sentinel (proc event)
"Flush file caches and remove shell prompt."
(unless (process-live-p proc)
(let ((vec (process-get proc 'vector))
(prompt (tramp-get-connection-property proc "prompt" nil)))
(when vec
(tramp-message vec 5 "Sentinel called: `%S' `%s'" proc event)
(tramp-flush-connection-properties proc)
(tramp-flush-directory-properties vec ""))
(goto-char (point-max))
(when (and prompt (re-search-backward (regexp-quote prompt) nil t))
(delete-region (point) (point-max))))))
(defun tramp-get-inode (vec)
"Returns the virtual inode number.
If it doesn't exist, generate a new one."
......
......@@ -3849,12 +3849,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
"Check `start-file-process'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let ((default-directory tramp-test-temporary-file-directory)
(tmp-name (tramp--test-make-temp-name nil quoted))
kill-buffer-query-functions proc)
;; Simple process.
(unwind-protect
(with-temp-buffer
(setq proc (start-file-process "test1" (current-buffer) "cat"))
......@@ -3866,11 +3868,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
(should (string-equal (buffer-string) "foo")))
;; We cannot use `string-equal', because tramp-adb.el
;; echoes also the sent string.
(should (string-match "\\`foo" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
;; Simple process using a file.
(unwind-protect
(with-temp-buffer
(write-region "foo" nil tmp-name)
......@@ -3891,6 +3896,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(delete-process proc)
(delete-file tmp-name)))
;; Process filter.
(unwind-protect
(with-temp-buffer
(setq proc (start-file-process "test3" (current-buffer) "cat"))
......@@ -3905,7 +3911,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
(should (string-equal (buffer-string) "foo")))
;; We cannot use `string-equal', because tramp-adb.el
;; echoes also the sent string.
(should (string-match "\\`foo" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc))))))
......@@ -3914,7 +3922,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
"Check `make-process'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
(skip-unless (tramp--test-emacs27-p))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
......@@ -3938,7 +3946,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
(should (string-equal (buffer-string) "foo")))
;; We cannot use `string-equal', because tramp-adb.el
;; echoes also the sent string.
(should (string-match "\\`foo" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
......@@ -3981,9 +3991,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(process-send-eof proc)
;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (not (string-match "foo" (buffer-string)))
(while (accept-process-output proc 0 nil t))))
(should (string-equal (buffer-string) "foo")))
;; We cannot use `string-equal', because tramp-adb.el
;; echoes also the sent string.
(should (string-match "\\`foo" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
......@@ -4006,33 +4018,37 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
(while (accept-process-output proc 0 nil t)))
(should (string-equal (buffer-string) "killed\n")))
;; We cannot use `string-equal', because tramp-adb.el
;; echoes also the sent string.
(should (string-match "killed\n\\'" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
;; Process with stderr.
(let ((stderr (generate-new-buffer (generate-new-buffer-name "stderr"))))
(unwind-protect
(with-temp-buffer
(setq proc
(make-process
:name "test5" :buffer (current-buffer)
:command '("cat" "/")
:stderr stderr
:file-handler t))
(should (processp proc))
;; Read stderr.
(with-current-buffer stderr
(with-timeout (10 (tramp--test-timeout-handler))
(while (= (point-min) (point-max))
(while (accept-process-output proc 0 nil t))))
(should
(string-equal (buffer-string) "cat: /: Is a directory\n"))))
;; Process with stderr. tramp-adb.el doesn't support it (yet).
(unless (tramp--test-adb-p)
(let ((stderr
(generate-new-buffer (generate-new-buffer-name "stderr"))))
(unwind-protect
(with-temp-buffer
(setq proc
(make-process
:name "test5" :buffer (current-buffer)
:command '("cat" "/")
:stderr stderr
:file-handler t))
(should (processp proc))
;; Read stderr.
(with-current-buffer stderr
(with-timeout (10 (tramp--test-timeout-handler))
(while (= (point-min) (point-max))
(while (accept-process-output proc 0 nil t))))
(should
(string-equal (buffer-string) "cat: /: Is a directory\n"))))
;; Cleanup.
(ignore-errors (delete-process proc))
(ignore-errors (kill-buffer stderr)))))))
;; Cleanup.
(ignore-errors (delete-process proc))
(ignore-errors (kill-buffer stderr))))))))
(ert-deftest tramp-test31-interrupt-process ()
"Check `interrupt-process'."
......@@ -4096,8 +4112,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Cleanup.
(ignore-errors (delete-file tmp-name)))
;; tramp-adb.el is not fit yet for asynchronous processes.
(unless (tramp--test-adb-p)
(unwind-protect
(with-temp-buffer
(write-region "foo" nil tmp-name)
......@@ -4124,10 +4138,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(buffer-string))))
;; Cleanup.
(ignore-errors (delete-file tmp-name))))
(ignore-errors (delete-file tmp-name)))
;; tramp-adb.el is not fit yet for asynchronous processes.
(unless (tramp--test-adb-p)
(unwind-protect
(with-temp-buffer
(write-region "foo" nil tmp-name)
......@@ -4155,7 +4167,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(buffer-string))))
;; Cleanup.
(ignore-errors (delete-file tmp-name)))))))
(ignore-errors (delete-file tmp-name))))))
(defun tramp--test-shell-command-to-string-asynchronously (command)
"Like `shell-command-to-string', but for asynchronous processes."
......@@ -4350,9 +4362,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; The functions were introduced in Emacs 26.1.
(ert-deftest tramp-test34-explicit-shell-file-name ()
"Check that connection-local `explicit-shell-file-name' is set."
;; The handling of connection-local variables has changed. Test
;; must be reworked.
:tags '(:expensive-test :unstable)
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
;; Since Emacs 26.1.
......@@ -4368,15 +4378,16 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(unwind-protect
(progn
;; `shell-mode' would ruin our test, because it deletes all
;; buffer local variables.
;; buffer local variables. Not needed in Emacs 27.1.
(put 'explicit-shell-file-name 'permanent-local t)
;; Declare connection-local variable `explicit-shell-file-name'.
;; Declare connection-local variables `explicit-shell-file-name'
;; and `explicit-sh-args'.
(with-no-warnings
(connection-local-set-profile-variables
'remote-sh
`((explicit-shell-file-name
. ,(if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh"))
(explicit-sh-args . ("-i"))))
(explicit-sh-args . ("-c" "echo foo"))))
(connection-local-set-profiles
`(:application tramp
:protocol ,(file-remote-p default-directory 'method)
......@@ -4386,14 +4397,18 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(put 'explicit-shell-file-name 'safe-local-variable #'identity)
(put 'explicit-sh-args 'safe-local-variable #'identity)
;; Run interactive shell. Since the default directory is
;; remote, `explicit-shell-file-name' shall be set in order
;; to avoid a question.
;; Run `shell' interactively. Since the default directory
;; is remote, `explicit-shell-file-name' shall be set in
;; order to avoid a question. `explicit-sh-args' echoes the
;; test data.
(with-current-buffer (get-buffer-create "*shell*")
(ignore-errors (kill-process (current-buffer)))
(should-not explicit-shell-file-name)
(call-interactively #'shell)
(should explicit-shell-file-name)))
(with-timeout (10)
(while (accept-process-output
(get-buffer-process (current-buffer)) nil nil t)))
(should (string-match "^foo$" (buffer-string)))))
;; Cleanup.
(put 'explicit-shell-file-name 'permanent-local nil)
......@@ -5714,11 +5729,8 @@ Since it unloads Tramp, it shall be the last test to run."
;; do not work properly for `nextcloud'.
;; * Fix `tramp-test29-start-file-process' and
;; `tramp-test30-make-process' on MS Windows (`process-send-eof'?).
;; * Fix `tramp-test29-start-file-process',
;; `tramp-test30-make-process' and `tramp-test32-shell-command' for
;; `adb' (see comment in `tramp-adb-send-command').
;; * Rework `tramp-test34-explicit-shell-file-name'.
;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'.
;; * Fix `tramp-test44-threads'.
(provide 'tramp-tests)
;;; tramp-tests.el ends here
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment