From: Michael Albinus Date: Sat, 20 May 2023 10:13:09 +0000 (+0200) Subject: Improve handling of ANSI control sequences in Tramp X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=870a078c06102e763d57366c123980545e245d9e;p=emacs.git Improve handling of ANSI control sequences in Tramp * lisp/net/tramp-compat.el (ansi-color): Require. * lisp/net/tramp-sh.el (tramp-display-escape-sequence-regexp) (tramp-device-escape-sequence-regexp): Delete. (tramp-sh-handle-insert-directory, tramp-barf-if-no-shell-prompt) (tramp-wait-for-output): Use `ansi-color-control-seq-regexp'. * lisp/net/tramp.el (tramp-shell-prompt-pattern): Remove escape characters. (tramp-process-one-action, tramp-convert-file-attributes): Use `ansi-color-control-seq-regexp'. (Bug#63539) * test/lisp/net/tramp-tests.el (tramp-display-escape-sequence-regexp): Dont't declare. (tramp-test28-process-file, tramp-test32-shell-command): Use `ansi-color-control-seq-regexp'. (tramp-test45-asynchronous-requests): Adapt test. --- diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 43544ae327e..40ea47ede40 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -29,6 +29,7 @@ ;;; Code: +(require 'ansi-color) (require 'auth-source) (require 'format-spec) (require 'ls-lisp) ;; Due to `tramp-handle-insert-directory'. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 49e6d2d7aa9..d4933ad7ba6 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -80,13 +80,6 @@ the default storage location, e.g. \"$HOME/.sh_history\"." (const :tag "Unset HISTFILE" t) (string :tag "Redirect to a file"))) -;;;###tramp-autoload -(defconst tramp-display-escape-sequence-regexp (rx "\e" (+ (any ";[" digit)) "m") - "Terminal control escape sequences for display attributes.") - -(defconst tramp-device-escape-sequence-regexp (rx "\e" (+ (any "[" digit)) "n") - "Terminal control escape sequences for device status.") - ;; ksh on OpenBSD 4.5 requires that $PS1 contains a `#' character for ;; root users. It uses the `$' character for other users. In order ;; to guarantee a proper prompt, we use "#$ " for the prompt. @@ -2654,7 +2647,7 @@ The method used must be an out-of-band method." (unless (tramp-compat-string-search "color" (tramp-get-connection-property v "ls" "")) (goto-char (point-min)) - (while (re-search-forward tramp-display-escape-sequence-regexp nil t) + (while (re-search-forward ansi-color-control-seq-regexp nil t) (replace-match ""))) ;; Now decode what read if necessary. Stolen from `insert-directory'. @@ -4323,6 +4316,7 @@ seconds. If not, it produces an error message with the given ERROR-ARGS." proc timeout (rx (| (regexp shell-prompt-pattern) (regexp tramp-shell-prompt-pattern)) + (? (regexp ansi-color-control-seq-regexp)) eos)) (error (delete-process proc) @@ -4831,6 +4825,7 @@ Goes through the list `tramp-inline-compress-commands'." "Check, whether local ssh OPTION is applicable." ;; We don't want to cache it persistently. (with-tramp-connection-property nil option + ;; "ssh -G" is introduced in OpenSSH 6.7. ;; We use a non-existing IP address for check, in order to avoid ;; useless connections, and DNS timeouts. (zerop @@ -5306,7 +5301,7 @@ function waits for output unless NOOUTPUT is set." (regexp (rx (* (not (any "#$\n"))) (literal tramp-end-of-output) - (? (regexp tramp-device-escape-sequence-regexp)) + (? (regexp ansi-color-control-seq-regexp)) (? "\r") eol)) ;; Sometimes, the commands do not return a newline but a ;; null byte before the shell prompt, for example "git diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 910d534330c..f986d65d944 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -624,9 +624,7 @@ Sometimes the prompt is reported to look like \"login as:\"." ;; connection initialization; Tramp redefines the prompt afterwards. (rx (| bol "\r") (* (not (any "\n#$%>]"))) - (? "#") (any "#$%>]") (* blank) - ;; Escape characters. - (* "[" (* (any ";" digit)) alpha (* blank))) + (? "#") (any "#$%>]") (* blank)) "Regexp to match prompts from remote shell. Normally, Tramp expects you to configure `shell-prompt-pattern' correctly, but sometimes it happens that you are connecting to a @@ -5711,6 +5709,12 @@ Wait, until the connection buffer changes." "Wait for output from the shell and perform one action. See `tramp-process-actions' for the format of ACTIONS." (let ((case-fold-search t) + (shell-prompt-pattern + (rx (regexp shell-prompt-pattern) + (? (regexp ansi-color-control-seq-regexp)))) + (tramp-shell-prompt-pattern + (rx (regexp tramp-shell-prompt-pattern) + (? (regexp ansi-color-control-seq-regexp)))) tramp-process-action-regexp found todo item pattern action) (while (not found) @@ -5721,7 +5725,7 @@ See `tramp-process-actions' for the format of ACTIONS." (while todo (setq item (pop todo) tramp-process-action-regexp (symbol-value (nth 0 item)) - pattern (format "\\(%s\\)\\'" tramp-process-action-regexp) + pattern (rx (group (regexp tramp-process-action-regexp)) eos) action (nth 1 item)) (tramp-message vec 5 "Looking for regexp \"%s\" from remote shell" pattern) @@ -6278,8 +6282,7 @@ to cache the result. Return the modified ATTR." (save-match-data ;; Remove color escape sequences from symlink. (when (stringp (car attr)) - (while (string-match - tramp-display-escape-sequence-regexp (car attr)) + (while (string-match ansi-color-control-seq-regexp (car attr)) (setcar attr (replace-match "" nil nil (car attr))))) ;; Convert uid and gid. Use `tramp-unknown-id-integer' ;; as indication of unusable value. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 6c773908e26..eec4a66a329 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -66,7 +66,6 @@ (defvar ange-ftp-make-backup-files) (defvar tramp-connection-properties) (defvar tramp-copy-size-limit) -(defvar tramp-display-escape-sequence-regexp) (defvar tramp-fuse-remove-hidden-files) (defvar tramp-fuse-unmount-on-cleanup) (defvar tramp-inline-compress-start-size) @@ -4941,8 +4940,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (if (bufferp destination) destination (current-buffer)) ;; "ls" could produce colorized output. (goto-char (point-min)) - (while (re-search-forward - tramp-display-escape-sequence-regexp nil t) + (while (re-search-forward ansi-color-control-seq-regexp nil t) (replace-match "" nil nil)) (should (string-equal (if destination (format "%s\n" fnnd) "") @@ -4956,8 +4954,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (if (bufferp destination) destination (current-buffer)) ;; "ls" could produce colorized output. (goto-char (point-min)) - (while (re-search-forward - tramp-display-escape-sequence-regexp nil t) + (while (re-search-forward ansi-color-control-seq-regexp nil t) (replace-match "" nil nil)) (should (string-equal @@ -5671,8 +5668,7 @@ INPUT, if non-nil, is a string sent to the process." (current-buffer)) ;; "ls" could produce colorized output. (goto-char (point-min)) - (while - (re-search-forward tramp-display-escape-sequence-regexp nil t) + (while (re-search-forward ansi-color-control-seq-regexp nil t) (replace-match "" nil nil)) (should (string-equal @@ -7589,34 +7585,37 @@ process sentinels. They shall not disturb each other." ;; Send a string to the processes. Use a random order of ;; the buffers. Mix with regular operation. - (let ((buffers (copy-sequence buffers))) + (let ((buffers (copy-sequence buffers)) + buf) (while buffers - (let* ((buf (seq-random-elt buffers)) - (proc (get-buffer-process buf)) - (file (process-get proc 'foo)) - (count (process-get proc 'bar))) - (tramp--test-message - "Start action %d %s %s" count buf (current-time-string)) - ;; Regular operation prior process action. - (dired-uncache file) - (if (= count 0) - (should-not (file-attributes file)) - (should (file-attributes file))) - ;; Send string to process. - (process-send-string proc (format "%s\n" (buffer-name buf))) - (while (accept-process-output nil 0)) - (tramp--test-message - "Continue action %d %s %s" count buf (current-time-string)) - ;; Regular operation post process action. - (dired-uncache file) - (if (= count 2) - (should-not (file-attributes file)) - (should (file-attributes file))) - (tramp--test-message - "Stop action %d %s %s" count buf (current-time-string)) - (process-put proc 'bar (1+ count)) - (unless (process-live-p proc) - (setq buffers (delq buf buffers)))))) + (setq buf (seq-random-elt buffers)) + (if-let ((proc (get-buffer-process buf)) + (file (process-get proc 'foo)) + (count (process-get proc 'bar))) + (progn + (tramp--test-message + "Start action %d %s %s" count buf (current-time-string)) + ;; Regular operation prior process action. + (dired-uncache file) + (if (= count 0) + (should-not (file-attributes file)) + (should (file-attributes file))) + ;; Send string to process. + (process-send-string proc (format "%s\n" (buffer-name buf))) + (while (accept-process-output nil 0)) + (tramp--test-message + "Continue action %d %s %s" count buf (current-time-string)) + ;; Regular operation post process action. + (dired-uncache file) + (if (= count 2) + (should-not (file-attributes file)) + (should (file-attributes file))) + (tramp--test-message + "Stop action %d %s %s" count buf (current-time-string)) + (process-put proc 'bar (1+ count)) + (unless (process-live-p proc) + (setq buffers (delq buf buffers)))) + (setq buffers (delq buf buffers))))) ;; Checks. All process output shall exist in the ;; respective buffers. All created files shall be