Allow Tramp to mirror traces to a file

* doc/misc/tramp.texi (Traces and Profiles): Add `tramp-debug-to-file'.

* lisp/net/tramp-adb.el (tramp-adb-parse-device-names)
(tramp-adb-get-device):
* lisp/net/tramp-cmds.el (tramp-rename-files):
* lisp/net/tramp-gvfs.el (tramp-gvfs-monitor-process-filter)
(tramp-gvfs-handler-volumeadded-volumeremoved)
(tramp-get-media-devices):
* lisp/net/tramp-sh.el (tramp-sh-handle-file-notify-add-watch)
(tramp-sh-gio-monitor-process-filter)
(tramp-sh-gvfs-monitor-dir-process-filter)
(tramp-sh-inotifywait-process-filter, tramp-maybe-send-script)
(tramp-find-inline-encoding):
* lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory)
(tramp-smb-handle-file-acl, tramp-smb-handle-set-file-acl):
Use `tramp-compat-string-replace'.

* lisp/net/tramp-compat.el (tramp-compat-string-replace): New defalias.

* lisp/net/tramp.el (tramp-debug-to-file): New defcustom.
(tramp-get-debug-buffer): Simplify.
(tramp-get-debug-file-name): New defun.
(tramp-debug-message): Write debug file if indicated.

doc/misc/tramp.texi

@@ -5043,6 +5043,7 @@ root-directory, it is most likely sufficient to make the
 @node Traces and Profiles
 @chapter How to Customize Traces
 @vindex tramp-verbose
+@vindex tramp-debug-to-file
 
 @value{tramp} messages are raised with verbosity levels ranging from 0
 to 10.  @value{tramp} does not display all messages; only those with a
@@ -5095,6 +5096,20 @@ If @code{tramp-verbose} is greater than or equal to 10, Lisp
 backtraces are also added to the @value{tramp} debug buffer in case of
 errors.
 
+In very rare cases it could happen, that @value{tramp} blocks Emacs.
+Killing Emacs does not allow to inspect the debug buffer.  In that
+case, you might instruct @value{tramp} to mirror the debug buffer to
+file:
+
+@lisp
+(customize-set-variable 'tramp-debug-to-file t)
+@end lisp
+
+The debug buffer is written as file in your
+@code{temporary-file-directory}, which is usually @file{/tmp/}.  Use
+this option with care, because it could decrease the performance of
+@value{tramp} actions.
+
 To enable stepping through @value{tramp} function call traces, they
 have to be specifically enabled as shown in this code:
 

lisp/net/tramp-adb.el

@@ -217,7 +217,7 @@ ARGUMENTS to pass to the OPERATION."
 	 (lambda (line)
 	   (when (string-match "^\\(\\S-+\\)[[:space:]]+device$" line)
 	     ;; Replace ":" by "#".
-	     `(nil ,(replace-regexp-in-string
+	     `(nil ,(tramp-compat-string-replace
 		     ":" tramp-prefix-port-format (match-string 1 line)))))
 	 (tramp-process-lines nil tramp-adb-program "devices"))))
 
@@ -1074,7 +1074,7 @@ E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\"
     (let* ((host (tramp-file-name-host vec))
 	   (port (tramp-file-name-port-or-default vec))
 	   (devices (mapcar #'cadr (tramp-adb-parse-device-names nil))))
-      (replace-regexp-in-string
+      (tramp-compat-string-replace
        tramp-prefix-port-format ":"
        (cond ((member host devices) host)
 	     ;; This is the case when the host is connected to the default port.
@@ -1090,7 +1090,7 @@ E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\"
 		   (not (zerop (length host)))
 		   (tramp-adb-execute-adb-command
                     vec "connect"
-                    (replace-regexp-in-string
+                    (tramp-compat-string-replace
 		     tramp-prefix-port-format ":" host)))
 	      ;; When new device connected, running other adb command (e.g.
 	      ;; adb shell) immediately will fail.  To get around this

lisp/net/tramp-cmds.el

@@ -387,8 +387,7 @@ ESC or `q' to quit without changing further buffers,
           (switch-to-buffer buffer)
 	  (let* ((bfn (buffer-file-name))
 		 (new-bfn (and (stringp bfn)
-			       (replace-regexp-in-string
-				(regexp-quote source) target bfn)))
+			       (tramp-compat-string-replace source target bfn)))
 		 (prompt (format-message
 			  "Set visited file name to `%s' [Type yn!eq or %s] "
 			  new-bfn (key-description (vector help-char)))))

lisp/net/tramp-compat.el

@@ -341,6 +341,13 @@ A nil value for either argument stands for the current time."
     (lambda ()
       (if (tramp-tramp-file-p default-directory) "/dev/null" null-device))))
 
+;; Function `string-replace' is new in Emacs 28.1.
+(defalias 'tramp-compat-string-replace
+  (if (fboundp 'string-replace)
+      #'string-replace
+    (lambda (fromstring tostring instring)
+      (replace-regexp-in-string (regexp-quote fromstring) tostring instring))))
+
 (add-hook 'tramp-unload-hook
 	  (lambda ()
 	    (unload-feature 'tramp-loaddefs 'force)

lisp/net/tramp-gvfs.el

@@ -1441,11 +1441,11 @@ If FILE-SYSTEM is non-nil, return file system attributes."
     (tramp-message proc 6 "%S\n%s" proc string)
     (setq string (concat rest-string string)
           ;; Fix action names.
-          string (replace-regexp-in-string
+          string (tramp-compat-string-replace
 	          "attributes changed" "attribute-changed" string)
-          string (replace-regexp-in-string
+          string (tramp-compat-string-replace
 	          "changes done" "changes-done-hint" string)
-          string (replace-regexp-in-string
+          string (tramp-compat-string-replace
 	          "renamed to" "moved" string))
     ;; https://bugs.launchpad.net/bugs/1742946
     (when
@@ -2050,7 +2050,7 @@ and \"org.gtk.Private.RemoteVolumeMonitor.VolumeRemoved\" signals."
 	   (vec (make-tramp-file-name
 		 :method "media"
 		 ;; A host name cannot contain spaces.
-		 :host (replace-regexp-in-string " " "_" (nth 1 volume))))
+		 :host (tramp-compat-string-replace " " "_" (nth 1 volume))))
 	   (media (make-tramp-media-device
 		   :method method
 		   :host (tramp-gvfs-url-host (nth 5 volume))
@@ -2355,7 +2355,7 @@ VEC is used only for traces."
 	       (vec (make-tramp-file-name
 		     :method "media"
 		     ;; A host name cannot contain spaces.
-		     :host (replace-regexp-in-string " " "_" (nth 1 volume))))
+		     :host (tramp-compat-string-replace " " "_" (nth 1 volume))))
 	       (media (make-tramp-media-device
 		       :method method
 		       :host (tramp-gvfs-url-host (nth 5 volume))

lisp/net/tramp-sh.el

@@ -3764,7 +3764,7 @@ Fall back to normal file name handler if no Tramp handler exists."
 	      ;; Make events a list of symbols.
 	      events
 	      (mapcar
-	       (lambda (x) (intern-soft (replace-regexp-in-string "_" "-" x)))
+	       (lambda (x) (intern-soft (tramp-compat-string-replace "_" "-" x)))
 	       (split-string events "," 'omit))))
        ;; "gio monitor".
        ((setq command (tramp-get-remote-gio-monitor v))
@@ -3836,11 +3836,11 @@ Fall back to normal file name handler if no Tramp handler exists."
     (tramp-message proc 6 "%S\n%s" proc string)
     (setq string (concat rest-string string)
           ;; Fix action names.
-          string (replace-regexp-in-string
+          string (tramp-compat-string-replace
 	          "attributes changed" "attribute-changed" string)
-          string (replace-regexp-in-string
+          string (tramp-compat-string-replace
 	          "changes done" "changes-done-hint" string)
-          string (replace-regexp-in-string
+          string (tramp-compat-string-replace
 	          "renamed to" "moved" string))
     ;; https://bugs.launchpad.net/bugs/1742946
     (when
@@ -3848,7 +3848,7 @@ Fall back to normal file name handler if no Tramp handler exists."
       (delete-process proc))
 
     ;; Delete empty lines.
-    (setq string (replace-regexp-in-string "\n\n" "\n" string))
+    (setq string (tramp-compat-string-replace "\n\n" "\n" string))
 
     (while (string-match
 	    (eval-when-compile
@@ -3896,7 +3896,7 @@ Fall back to normal file name handler if no Tramp handler exists."
     (tramp-message proc 6 "%S\n%s" proc string)
     (setq string (concat rest-string string)
 	  ;; Attribute change is returned in unused wording.
-	  string (replace-regexp-in-string
+	  string (tramp-compat-string-replace
 		  "ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string))
 
     (while (string-match
@@ -3913,7 +3913,7 @@ Fall back to normal file name handler if no Tramp handler exists."
 	       proc
 	       (list
 		(intern-soft
-		 (replace-regexp-in-string
+		 (tramp-compat-string-replace
 		  "_" "-" (downcase (match-string 4 string)))))
 	       ;; File names are returned as absolute paths.  We must
 	       ;; add the remote prefix.
@@ -3952,7 +3952,7 @@ Fall back to normal file name handler if no Tramp handler exists."
 	      (mapcar
 	       (lambda (x)
 		 (intern-soft
-		  (replace-regexp-in-string "_" "-" (downcase x))))
+		  (tramp-compat-string-replace "_" "-" (downcase x))))
 	       (split-string (match-string 1 line) "," 'omit))
 	      (or (match-string 3 line)
 		  (file-name-nondirectory (process-get proc 'watch-name))))))
@@ -4006,7 +4006,7 @@ Only send the definition if it has not already been done."
 	  vec 5 (format-message "Sending script `%s'" name)
 	;; In bash, leading TABs like in `tramp-vc-registered-read-file-names'
 	;; could result in unwanted command expansion.  Avoid this.
-	(setq script (replace-regexp-in-string
+	(setq script (tramp-compat-string-replace
 		      (make-string 1 ?\t) (make-string 8 ? ) script))
 	;; The script could contain a call of Perl.  This is masked with `%s'.
 	(when (and (string-match-p "%s" script)
@@ -4675,7 +4675,7 @@ Goes through the list `tramp-local-coding-commands' and
 				?n (concat
                                     "2>" (tramp-get-remote-null-device vec))
 				?o (tramp-get-remote-od vec)))
-			      value (replace-regexp-in-string "%" "%%" value)))
+			      value (tramp-compat-string-replace "%" "%%" value)))
 		      (tramp-maybe-send-script vec value name)
 		      (setq rem-enc name)))
 		  (tramp-message
@@ -4704,7 +4704,7 @@ Goes through the list `tramp-local-coding-commands' and
 				?n (concat
                                     "2>" (tramp-get-remote-null-device vec))
 				?o (tramp-get-remote-od vec)))
-			      value (replace-regexp-in-string "%" "%%" value)))
+			      value (tramp-compat-string-replace "%" "%%" value)))
 		      (when (string-match-p "\\(^\\|[^%]\\)%t" value)
 			(setq tmpfile (tramp-make-tramp-temp-name vec)
 			      value

lisp/net/tramp-smb.el

@@ -464,8 +464,8 @@ pass to the OPERATION."
 
 	    (let* ((share (tramp-smb-get-share v))
 		   (localname (file-name-as-directory
-			       (replace-regexp-in-string
-				"\\\\" "/" (tramp-smb-get-localname v))))
+			       (tramp-compat-string-replace
+				"\\" "/" (tramp-smb-get-localname v))))
 		   (tmpdir    (tramp-compat-make-temp-name))
 		   (args      (list (concat "//" host "/" share) "-E"))
 		   (options   tramp-smb-options))
@@ -777,8 +777,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
       (with-tramp-file-property v localname "file-acl"
 	(when (executable-find tramp-smb-acl-program)
 	  (let* ((share     (tramp-smb-get-share v))
-		 (localname (replace-regexp-in-string
-			     "\\\\" "/" (tramp-smb-get-localname v)))
+		 (localname (tramp-compat-string-replace
+			     "\\" "/" (tramp-smb-get-localname v)))
 		 (args      (list (concat "//" host "/" share) "-E"))
 		 (options   tramp-smb-options))
 
@@ -1445,10 +1445,10 @@ component is used as the target of the symlink."
 
       (when (and (stringp acl-string) (executable-find tramp-smb-acl-program))
 	(let* ((share     (tramp-smb-get-share v))
-	       (localname (replace-regexp-in-string
-			   "\\\\" "/" (tramp-smb-get-localname v)))
+	       (localname (tramp-compat-string-replace
+			   "\\" "/" (tramp-smb-get-localname v)))
 	       (args      (list (concat "//" host "/" share) "-E" "-S"
-				(replace-regexp-in-string
+				(tramp-compat-string-replace
 				 "\n" "," acl-string)))
 	       (options   tramp-smb-options))
 

lisp/net/tramp.el

@@ -112,6 +112,13 @@ Any level x includes messages for all levels 1 .. x-1.  The levels are
 10  traces (huge)."
   :type 'integer)
 
+(defcustom tramp-debug-to-file nil
+  "Whether Tramp debug messages shall be saved to file.
+The debug file has the same name as the debug buffer, written to
+`temporary-file-directory'."
+  :version "28.1"
+  :type 'boolean)
+
 (defcustom tramp-backup-directory-alist nil
   "Alist of filename patterns and backup directory names.
 Each element looks like (REGEXP . DIRECTORY), with the same meaning like
@@ -1722,8 +1729,7 @@ The outline level is equal to the verbosity of the Tramp message."
 
 (defun tramp-get-debug-buffer (vec)
   "Get the debug buffer for VEC."
-  (with-current-buffer
-      (get-buffer-create (tramp-debug-buffer-name vec))
+  (with-current-buffer (get-buffer-create (tramp-debug-buffer-name vec))
     (when (bobp)
       (setq buffer-undo-list t)
       ;; Activate `outline-mode'.  This runs `text-mode-hook' and
@@ -1732,8 +1738,7 @@ The outline level is equal to the verbosity of the Tramp message."
       ;; `(custom-declare-variable outline-minor-mode-prefix ...)'
       ;; raises on error in `(outline-mode)', we don't want to see it
       ;; in the traces.
-      (let ((default-directory (tramp-compat-temporary-file-directory))
-	    signal-hook-function)
+      (let ((default-directory (tramp-compat-temporary-file-directory)))
 	(outline-mode))
       (set (make-local-variable 'outline-level) 'tramp-debug-outline-level)
       (set (make-local-variable 'font-lock-keywords)
@@ -1743,56 +1748,73 @@ The outline level is equal to the verbosity of the Tramp message."
       (use-local-map special-mode-map))
     (current-buffer)))
 
+(defun tramp-get-debug-file-name (vec)
+  "Get the debug buffer for VEC."
+  (expand-file-name
+   (tramp-compat-string-replace "/" " " (tramp-debug-buffer-name vec))
+   (tramp-compat-temporary-file-directory)))
+
 (defsubst tramp-debug-message (vec fmt-string &rest arguments)
   "Append message to debug buffer of VEC.
 Message is formatted with FMT-STRING as control string and the remaining
 ARGUMENTS to actually emit the message (if applicable)."
-  (with-current-buffer (tramp-get-debug-buffer vec)
-    (goto-char (point-max))
-    ;; Headline.
-    (when (bobp)
-      (insert
-       (format
-	";; Emacs: %s Tramp: %s -*- mode: outline; -*-"
-	emacs-version tramp-version))
-      (when (>= tramp-verbose 10)
-	(let ((tramp-verbose 0))
+  (let ((inhibit-message t)
+	file-name-handler-alist message-log-max signal-hook-function)
+    (with-current-buffer (tramp-get-debug-buffer vec)
+      (goto-char (point-max))
+      (let ((point (point)))
+	;; Headline.
+	(when (bobp)
 	  (insert
 	   (format
-	    "\n;; Location: %s Git: %s/%s"
-	    (locate-library "tramp")
-	    (or tramp-repository-branch "")
-	    (or tramp-repository-version ""))))))
-    (unless (bolp)
-      (insert "\n"))
-    ;; Timestamp.
-    (let ((now (current-time)))
-      (insert (format-time-string "%T." now))
-      (insert (format "%06d " (nth 2 now))))
-    ;; Calling Tramp function.  We suppress compat and trace functions
-    ;; from being displayed.
-    (let ((btn 1) btf fn)
-      (while (not fn)
-	(setq btf (nth 1 (backtrace-frame btn)))
-	(if (not btf)
-	    (setq fn "")
-	  (and (symbolp btf) (setq fn (symbol-name btf))
-	       (or (not (string-match-p "^tramp" fn))
-		   (get btf 'tramp-suppress-trace))
-	       (setq fn nil))
-	  (setq btn (1+ btn))))
-      ;; The following code inserts filename and line number.  Should
-      ;; be inactive by default, because it is time consuming.
-;      (let ((ffn (find-function-noselect (intern fn))))
-;	(insert
-;	 (format
-;	  "%s:%d: "
-;	  (file-name-nondirectory (buffer-file-name (car ffn)))
-;	  (with-current-buffer (car ffn)
-;	    (1+ (count-lines (point-min) (cdr ffn)))))))
-      (insert (format "%s " fn)))
-    ;; The message.
-    (insert (apply #'format-message fmt-string arguments))))
+	    ";; Emacs: %s Tramp: %s -*- mode: outline; -*-"
+	    emacs-version tramp-version))
+	  (when (>= tramp-verbose 10)
+	    (let ((tramp-verbose 0))
+	      (insert
+	       (format
+		"\n;; Location: %s Git: %s/%s"
+		(locate-library "tramp")
+		(or tramp-repository-branch "")
+		(or tramp-repository-version "")))))
+	  ;; Delete debug file.
+	  (when (and tramp-debug-to-file (tramp-get-debug-file-name vec))
+	    (ignore-errors (delete-file (tramp-get-debug-file-name vec)))))
+	(unless (bolp)
+	  (insert "\n"))
+	;; Timestamp.
+	(let ((now (current-time)))
+	  (insert (format-time-string "%T." now))
+	  (insert (format "%06d " (nth 2 now))))
+	;; Calling Tramp function.  We suppress compat and trace
+	;; functions from being displayed.
+	(let ((btn 1) btf fn)
+	  (while (not fn)
+	    (setq btf (nth 1 (backtrace-frame btn)))
+	    (if (not btf)
+		(setq fn "")
+	      (and (symbolp btf) (setq fn (symbol-name btf))
+		   (or (not (string-match-p "^tramp" fn))
+		       (get btf 'tramp-suppress-trace))
+		   (setq fn nil))
+	      (setq btn (1+ btn))))
+	  ;; The following code inserts filename and line number.
+	  ;; Should be inactive by default, because it is time consuming.
+	  ;; (let ((ffn (find-function-noselect (intern fn))))
+	  ;;   (insert
+	  ;;    (format
+	  ;;     "%s:%d: "
+	  ;;     (file-name-nondirectory (buffer-file-name (car ffn)))
+	  ;;     (with-current-buffer (car ffn)
+	  ;;       (1+ (count-lines (point-min) (cdr ffn)))))))
+	  (insert (format "%s " fn)))
+	;; The message.
+	(insert (apply #'format-message fmt-string arguments))
+	;; Write message to debug file.
+	(when tramp-debug-to-file
+	  (ignore-errors
+	    (write-region
+	     point (point-max) (tramp-get-debug-file-name vec) 'append)))))))
 
 (put #'tramp-debug-message 'tramp-suppress-trace t)