From: Michael Albinus Date: Wed, 3 Apr 2019 19:36:40 +0000 (+0200) Subject: Work on asynchronous processes for tramp-adb.el X-Git-Tag: emacs-27.0.90~3261^2~111 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=8147d3c27cbf29e18dbdd6bad21cd17bc880a8d3;p=emacs.git 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. --- diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 68960426b68..db9acbfc631 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -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) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index edd9af489e2..7d903c5769c 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -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. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 7206d8eb8a6..0fc2d33d222 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -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." diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 1c7198ce560..1ee11f0d38a 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -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