From efaed29f3dc7af15c9f97d87f9cbe790c73a2ea3 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 24 Aug 2021 21:42:42 +0200 Subject: [PATCH] Some precisements in Tramp's connection type handling * doc/misc/tramp.texi (Remote processes): Precise connection type handling. * lisp/net/tramp-adb.el (tramp-adb-handle-make-process): * lisp/net/tramp-sh.el (tramp-sh-handle-make-process): * lisp/net/tramp.el (tramp-handle-make-process): Fix :connection-type handling. (tramp-action-show-and-confirm-message): Pacify byte compiler. * lisp/net/tramp-compat.el (tramp-compat-ignore-error): New defmacro. * test/lisp/net/tramp-tests.el (tramp-test29-start-file-process) (tramp-test30-make-process): Extend tests. --- doc/misc/tramp.texi | 17 ++++--- lisp/net/tramp-adb.el | 8 +-- lisp/net/tramp-compat.el | 9 ++++ lisp/net/tramp-sh.el | 8 +-- lisp/net/tramp.el | 12 +++-- test/lisp/net/tramp-tests.el | 99 +++++++++++++++++++++++++----------- 6 files changed, 103 insertions(+), 50 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index bd9bd998dfb..b2dcddc7937 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -3745,19 +3745,20 @@ tty, or not. This is controlled by the variable @value{tramp} is based on running shells on the remote host, which require a pseudo tty. Therefore, it declares the variable @code{tramp-process-connection-type}, which carries this information -for remote processes. Per default, its value is @code{t}. The name -of the remote pseudo tty is returned by the function -@code{process-tty-name}. +for remote processes. Per default, its value is @code{t}, and there's +no need to change it. The name of the remote pseudo tty is returned +by the function @code{process-tty-name}. If a remote process, started by @code{start-file-process}, shouldn't -use a pseudo tty, this is emulated by let-binding this variable to -@code{nil} or @code{pipe}. There is still a pseudo tty for the -started process, but some terminal properties are changed, like -suppressing translation of carriage return characters into newline. +use a pseudo tty, this can be indicated by setting +@code{process-connection-type} to @code{nil} or @code{pipe}. There is +still a pseudo tty for the started process, but some terminal +properties are changed, like suppressing translation of carriage +return characters into newline. The function @code{make-process} allows an explicit setting by the @code{:connection-type} keyword. If this keyword is not used, the -value of @code{tramp-process-connection-type} is applied instead. +value of @code{process-connection-type} is applied instead. @anchor{Improving performance of asynchronous remote processes} diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index c16e232c6d5..70dbfdb9475 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -925,9 +925,7 @@ implementation will be used." (coding (plist-get args :coding)) (noquery (plist-get args :noquery)) (connection-type - (if (plist-member args :connection-type) - (plist-get args :connection-type) - tramp-process-connection-type)) + (or (plist-get args :connection-type) process-connection-type)) (filter (plist-get args :filter)) (sentinel (plist-get args :sentinel)) (stderr (plist-get args :stderr))) @@ -943,7 +941,9 @@ implementation will be used." (memq (car coding) coding-system-list) (memq (cdr coding) coding-system-list))) (signal 'wrong-type-argument (list #'symbolp coding))) - (unless (memq connection-type '(nil pipe t pty)) + (when (eq connection-type t) + (setq connection-type 'pty)) + (unless (memq connection-type '(nil pipe pty)) (signal 'wrong-type-argument (list #'symbolp connection-type))) (unless (or (null filter) (functionp filter)) (signal 'wrong-type-argument (list #'functionp filter))) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index b713d5eae82..125f82592f4 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -295,6 +295,15 @@ A nil value for either argument stands for the current time." (lambda (reporter &optional value _suffix) (progress-reporter-update reporter value)))) +;; `ignore-error' is new in Emacs Emacs 27.1. +(defmacro tramp-compat-ignore-error (condition &rest body) + "Execute BODY; if the error CONDITION occurs, return nil. +Otherwise, return result of last form in BODY. + +CONDITION can also be a list of error conditions." + (declare (debug t) (indent 1)) + `(condition-case nil (progn ,@body) (,condition nil))) + ;; `file-modes', `set-file-modes' and `set-file-times' got argument ;; FLAG in Emacs 28.1. (defalias 'tramp-compat-file-modes diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index e0bc28c983f..a2bf0afbf53 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2765,9 +2765,7 @@ implementation will be used." (coding (plist-get args :coding)) (noquery (plist-get args :noquery)) (connection-type - (if (plist-member args :connection-type) - (plist-get args :connection-type) - tramp-process-connection-type)) + (or (plist-get args :connection-type) process-connection-type)) (filter (plist-get args :filter)) (sentinel (plist-get args :sentinel)) (stderr (plist-get args :stderr))) @@ -2783,7 +2781,9 @@ implementation will be used." (memq (car coding) coding-system-list) (memq (cdr coding) coding-system-list))) (signal 'wrong-type-argument (list #'symbolp coding))) - (unless (memq connection-type '(nil pipe t pty)) + (when (eq connection-type t) + (setq connection-type 'pty)) + (unless (memq connection-type '(nil pipe pty)) (signal 'wrong-type-argument (list #'symbolp connection-type))) (unless (or (null filter) (functionp filter)) (signal 'wrong-type-argument (list #'functionp filter))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index b687eb76536..0973b5b4445 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4101,9 +4101,7 @@ substitution. SPEC-LIST is a list of char/value pairs used for (coding (plist-get args :coding)) (noquery (plist-get args :noquery)) (connection-type - (if (plist-member args :connection-type) - (plist-get args :connection-type) - tramp-process-connection-type)) + (or (plist-get args :connection-type) process-connection-type)) (filter (plist-get args :filter)) (sentinel (plist-get args :sentinel)) (stderr (plist-get args :stderr))) @@ -4119,7 +4117,9 @@ substitution. SPEC-LIST is a list of char/value pairs used for (memq (car coding) coding-system-list) (memq (cdr coding) coding-system-list))) (signal 'wrong-type-argument (list #'symbolp coding))) - (unless (memq connection-type '(nil pipe t pty)) + (when (eq connection-type t) + (setq connection-type 'pty)) + (unless (memq connection-type '(nil pipe pty)) (signal 'wrong-type-argument (list #'symbolp connection-type))) (unless (or (null filter) (functionp filter)) (signal 'wrong-type-argument (list #'functionp filter))) @@ -4702,13 +4702,15 @@ Wait, until the connection buffer changes." (let ((stimers (with-timeout-suspend)) (cursor-in-echo-area t) set-message-function clear-message-function) + ;; Silence byte compiler. + (ignore set-message-function clear-message-function) (tramp-message vec 6 "\n%s" (buffer-string)) (tramp-check-for-regexp proc tramp-process-action-regexp) (with-temp-message (replace-regexp-in-string "[\r\n]" "" (match-string 0)) ;; Hide message in buffer. (narrow-to-region (point-max) (point-max)) ;; Wait for new output. - (while (not (ignore-error 'file-error + (while (not (tramp-compat-ignore-error 'file-error (tramp-wait-for-regexp proc 0.1 tramp-security-key-confirmed-regexp))) (when (tramp-check-for-regexp proc tramp-security-key-timeout-regexp) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 127a9bee955..9a9684dd736 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4577,16 +4577,50 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Cleanup. (ignore-errors (delete-process proc))) + ;; Process connection type. + (when (and (tramp--test-sh-p) + ;; `executable-find' has changed the number of + ;; parameters in Emacs 27.1, so we use `apply' for + ;; older Emacsen. + (ignore-errors + (with-no-warnings + (apply #'executable-find '("hexdump" remote))))) + (dolist (process-connection-type '(nil pipe t pty)) + (unwind-protect + (with-temp-buffer + (setq proc + (start-file-process + (format "test4-%s" process-connection-type) + (current-buffer) "hexdump" "-v" "-e" "/1 \"%02X\n\"")) + (should (processp proc)) + (should (equal (process-status proc) 'run)) + (process-send-string proc "foo\r\n") + (process-send-eof proc) + ;; Read output. + (with-timeout (10 (tramp--test-timeout-handler)) + (while (< (- (point-max) (point-min)) + (length "66\n6F\n6F\n0D\n0A\n")) + (while (accept-process-output proc 0 nil t)))) + (should + (string-match-p + (if (memq process-connection-type '(nil pipe)) + "66\n6F\n6F\n0D\n0A\n" + "66\n6F\n6F\n0A\n0A\n") + (buffer-string)))) + + ;; Cleanup. + (ignore-errors (delete-process proc))))) + ;; PTY. (unwind-protect (with-temp-buffer ;; It works only for tramp-sh.el, and not direct async processes. (if (or (not (tramp--test-sh-p)) (tramp-direct-async-process-p)) (should-error - (start-file-process "test4" (current-buffer) nil) + (start-file-process "test5" (current-buffer) nil) :type 'wrong-type-argument) - (setq proc (start-file-process "test4" (current-buffer) nil)) + (setq proc (start-file-process "test5" (current-buffer) nil)) (should (processp proc)) (should (equal (process-status proc) 'run)) ;; On MS Windows, `process-tty-name' returns nil. @@ -4802,34 +4836,41 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (with-no-warnings (apply #'executable-find '("hexdump" remote))))) (dolist (connection-type '(nil pipe t pty)) - (unwind-protect - (with-temp-buffer - (setq proc - (with-no-warnings - (make-process - :name (format "test7-%s" connection-type) - :buffer (current-buffer) - :connection-type connection-type - :command '("hexdump" "-v" "-e" "/1 \"%02X\n\"") - :file-handler t))) - (should (processp proc)) - (should (equal (process-status proc) 'run)) - (process-send-string proc "foo\r\n") - (process-send-eof proc) - ;; Read output. - (with-timeout (10 (tramp--test-timeout-handler)) - (while (< (- (point-max) (point-min)) - (length "66\n6F\n6F\n0D\n0A\n")) - (while (accept-process-output proc 0 nil t)))) - (should - (string-match-p - (if (memq connection-type '(nil pipe)) - "66\n6F\n6F\n0D\n0A\n" - "66\n6F\n6F\n0A\n0A\n") - (buffer-string)))) + ;; `process-connection-type' is taken when + ;; `:connection-type' is nil. + (dolist (process-connection-type + (unless connection-type '(nil pipe t pty))) + (unwind-protect + (with-temp-buffer + (setq proc + (with-no-warnings + (make-process + :name + (format "test7-%s-%s" + connection-type process-connection-type) + :buffer (current-buffer) + :connection-type connection-type + :command '("hexdump" "-v" "-e" "/1 \"%02X\n\"") + :file-handler t))) + (should (processp proc)) + (should (equal (process-status proc) 'run)) + (process-send-string proc "foo\r\n") + (process-send-eof proc) + ;; Read output. + (with-timeout (10 (tramp--test-timeout-handler)) + (while (< (- (point-max) (point-min)) + (length "66\n6F\n6F\n0D\n0A\n")) + (while (accept-process-output proc 0 nil t)))) + (should + (string-match-p + (if (memq (or connection-type process-connection-type) + '(nil pipe)) + "66\n6F\n6F\n0D\n0A\n" + "66\n6F\n6F\n0A\n0A\n") + (buffer-string)))) - ;; Cleanup. - (ignore-errors (delete-process proc)))))))) + ;; Cleanup. + (ignore-errors (delete-process proc))))))))) (tramp--test--deftest-direct-async-process tramp-test30-make-process "Check direct async `make-process'.") -- 2.39.2