[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master ba692b7 2/3: Allow Tramp to mirror traces to a file
|
From: |
Michael Albinus |
|
Subject: |
master ba692b7 2/3: Allow Tramp to mirror traces to a file |
|
Date: |
Tue, 1 Dec 2020 07:37:43 -0500 (EST) |
branch: master
commit ba692b790da79cde98932295362a5de138991d47
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>
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 | 15 ++++++
lisp/net/tramp-adb.el | 6 +--
lisp/net/tramp-cmds.el | 3 +-
lisp/net/tramp-compat.el | 7 +++
lisp/net/tramp-gvfs.el | 10 ++--
lisp/net/tramp-sh.el | 22 ++++-----
lisp/net/tramp-smb.el | 14 +++---
lisp/net/tramp.el | 118 ++++++++++++++++++++++++++++-------------------
8 files changed, 119 insertions(+), 76 deletions(-)
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index f853c6d..59b8bdb 100644
--- a/doc/misc/tramp.texi
+++ b/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:
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 51cb316..4947d16 100644
--- a/lisp/net/tramp-adb.el
+++ b/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
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 827d5f6..622116d 100644
--- a/lisp/net/tramp-cmds.el
+++ b/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)))))
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 7fae9ba..b44eabc 100644
--- a/lisp/net/tramp-compat.el
+++ b/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)
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 098fba5..40a7cbb 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/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))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 2851110..1ce6542 100644
--- a/lisp/net/tramp-sh.el
+++ b/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
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index cafa97c..e521371 100644
--- a/lisp/net/tramp-smb.el
+++ b/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))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 6ae79be..c367182 100644
--- a/lisp/net/tramp.el
+++ b/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)