master 870a078c061: Improve handling of ANSI control sequences in Tramp

[Michael Albinus]

branch: master
commit 870a078c06102e763d57366c123980545e245d9e
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    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.
---
 lisp/net/tramp-compat.el     |  1 +
 lisp/net/tramp-sh.el         | 13 +++------
 lisp/net/tramp.el            | 15 ++++++----
 test/lisp/net/tramp-tests.el | 67 ++++++++++++++++++++++----------------------
 4 files changed, 47 insertions(+), 49 deletions(-)

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