procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Improve handling of ANSI control sequences in Tramp

Browse source 
* 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.
This commit is contained in:
Michael Albinus 2023-05-20 12:13:09 +02:00
parent 0de472e04f
commit 870a078c06
4 changed files with 47 additions and 49 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
lisp/net/tramp-compat.el
View file

@ -29,6 +29,7 @@
;;; Code:
(require 'ansi-color)
(require 'auth-source)
(require 'format-spec)
(require 'ls-lisp) ;; Due to `tramp-handle-insert-directory'.

13
lisp/net/tramp-sh.el
View file

@ -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

15
lisp/net/tramp.el
View file

@ -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.

67
test/lisp/net/tramp-tests.el
View file

@ -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