Commit ba692b79 authored by Michael Albinus's avatar Michael Albinus
Browse files

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.
parent 3d712d50
......@@ -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:
......
......@@ -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
......
......@@ -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)))))
......
......@@ -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)
......
......@@ -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))
......
......@@ -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
......
......@@ -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))
......
......@@ -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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment