Tune Tramp traces
* doc/misc/tramp.texi (Traces and Profiles): Describe call traces. * lisp/net/tramp-compat.el: Add `tramp-suppress-trace' property for all functions. * lisp/net/tramp.el (tramp-verbose): Adapt docstring. (tramp-file-name-method, tramp-file-name-user) (tramp-file-name-domain, tramp-file-name-host) (tramp-file-name-port, tramp-file-name-localname) (tramp-file-name-hop, tramp-file-name-user-domain) (tramp-file-name-host-port, tramp-file-name-port-or-default) (tramp-tramp-file-p, tramp-find-method, tramp-find-user) (tramp-find-host, tramp-dissect-file-name) (tramp-dissect-hop-name, tramp-debug-buffer-name) (tramp-debug-outline-level, tramp-get-debug-buffer) (tramp-get-debug-file-name, tramp-read-passwd) (tramp-clear-passwd): Add `tramp-suppress-trace' property. (tramp-debug-message): Activate call traces. * test/lisp/net/tramp-tests.el (tramp--test-instrument-test-case): Simplify.
This commit is contained in:
Michael Albinus
parent
704755a568
commit
70bfcbcdd3
4 changed files with 58 additions and 28 deletions
|
|
@ -5336,6 +5336,7 @@ The verbosity levels are
|
|||
@*@indent @w{ 8} connection properties
|
||||
@*@indent @w{ 9} test commands
|
||||
@*@indent @w{10} traces (huge)
|
||||
@*@indent @w{11} call traces (maintainer only)
|
||||
|
||||
With @code{tramp-verbose} greater than or equal to 4, messages are
|
||||
also written to a @value{tramp} debug buffer. Such debug buffers are
|
||||
|
|
@ -5384,21 +5385,8 @@ The debug buffer is written as a file in your
|
|||
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
|
||||
@group
|
||||
(require 'trace)
|
||||
(dolist (elt (all-completions "tramp-" obarray 'functionp))
|
||||
(trace-function-background (intern elt)))
|
||||
(untrace-function 'tramp-read-passwd)
|
||||
@end group
|
||||
@end lisp
|
||||
|
||||
The buffer @file{*trace-output*} contains the output from the function
|
||||
call traces. Disable @code{tramp-read-passwd} to stop password
|
||||
strings from being written to @file{*trace-output*}.
|
||||
If @code{tramp-verbose} is greater than or equal to 11, @value{tramp}
|
||||
function call traces are written to the buffer @file{*trace-output*}.
|
||||
|
||||
|
||||
@node GNU Free Documentation License
|
||||
|
|
|
|||
|
|
@ -63,8 +63,6 @@
|
|||
`(when (functionp ,function)
|
||||
(with-no-warnings (funcall ,function ,@arguments))))
|
||||
|
||||
(put #'tramp-compat-funcall 'tramp-suppress-trace t)
|
||||
|
||||
(defsubst tramp-compat-temporary-file-directory ()
|
||||
"Return name of directory for temporary files.
|
||||
It is the default value of `temporary-file-directory'."
|
||||
|
|
@ -355,6 +353,9 @@ A nil value for either argument stands for the current time."
|
|||
(lambda (fromstring tostring instring)
|
||||
(replace-regexp-in-string (regexp-quote fromstring) tostring instring))))
|
||||
|
||||
(dolist (elt (all-completions "tramp-compat-" obarray 'functionp))
|
||||
(put (intern elt) 'tramp-suppress-trace t))
|
||||
|
||||
(add-hook 'tramp-unload-hook
|
||||
(lambda ()
|
||||
(unload-feature 'tramp-loaddefs 'force)
|
||||
|
|
|
|||
|
|
@ -109,7 +109,8 @@ Any level x includes messages for all levels 1 .. x-1. The levels are
|
|||
7 file caching
|
||||
8 connection properties
|
||||
9 test commands
|
||||
10 traces (huge)."
|
||||
10 traces (huge)
|
||||
11 call traces (maintainer only)."
|
||||
:type 'integer)
|
||||
|
||||
(defcustom tramp-debug-to-file nil
|
||||
|
|
@ -1390,6 +1391,14 @@ calling HANDLER.")
|
|||
(cl-defstruct (tramp-file-name (:type list) :named)
|
||||
method user domain host port localname hop)
|
||||
|
||||
(put #'tramp-file-name-method 'tramp-suppress-trace t)
|
||||
(put #'tramp-file-name-user 'tramp-suppress-trace t)
|
||||
(put #'tramp-file-name-domain 'tramp-suppress-trace t)
|
||||
(put #'tramp-file-name-host 'tramp-suppress-trace t)
|
||||
(put #'tramp-file-name-port 'tramp-suppress-trace t)
|
||||
(put #'tramp-file-name-localname 'tramp-suppress-trace t)
|
||||
(put #'tramp-file-name-hop 'tramp-suppress-trace t)
|
||||
|
||||
(defun tramp-file-name-user-domain (vec)
|
||||
"Return user and domain components of VEC."
|
||||
(when (or (tramp-file-name-user vec) (tramp-file-name-domain vec))
|
||||
|
|
@ -1398,6 +1407,8 @@ calling HANDLER.")
|
|||
tramp-prefix-domain-format)
|
||||
(tramp-file-name-domain vec))))
|
||||
|
||||
(put #'tramp-file-name-user-domain 'tramp-suppress-trace t)
|
||||
|
||||
(defun tramp-file-name-host-port (vec)
|
||||
"Return host and port components of VEC."
|
||||
(when (or (tramp-file-name-host vec) (tramp-file-name-port vec))
|
||||
|
|
@ -1406,12 +1417,16 @@ calling HANDLER.")
|
|||
tramp-prefix-port-format)
|
||||
(tramp-file-name-port vec))))
|
||||
|
||||
(put #'tramp-file-name-host-port 'tramp-suppress-trace t)
|
||||
|
||||
(defun tramp-file-name-port-or-default (vec)
|
||||
"Return port component of VEC.
|
||||
If nil, return `tramp-default-port'."
|
||||
(or (tramp-file-name-port vec)
|
||||
(tramp-get-method-parameter vec 'tramp-default-port)))
|
||||
|
||||
(put #'tramp-file-name-port-or-default 'tramp-suppress-trace t)
|
||||
|
||||
;; Comparison of file names is performed by `tramp-equal-remote'.
|
||||
(defun tramp-file-name-equal-p (vec1 vec2)
|
||||
"Check, whether VEC1 and VEC2 denote the same `tramp-file-name'."
|
||||
|
|
@ -1458,6 +1473,8 @@ entry does not exist, return nil."
|
|||
(string-match-p tramp-file-name-regexp name)
|
||||
t))
|
||||
|
||||
(put #'tramp-tramp-file-p 'tramp-suppress-trace t)
|
||||
|
||||
;; This function bypasses the file name handler approach. It is NOT
|
||||
;; recommended to use it in any package if not absolutely necessary.
|
||||
;; However, it is more performant than `file-local-name', and might be
|
||||
|
|
@ -1506,6 +1523,8 @@ This is METHOD, if non-nil. Otherwise, do a lookup in
|
|||
result
|
||||
(propertize result 'tramp-default t))))
|
||||
|
||||
(put #'tramp-find-method 'tramp-suppress-trace t)
|
||||
|
||||
(defun tramp-find-user (method user host)
|
||||
"Return the right user string to use depending on METHOD and HOST.
|
||||
This is USER, if non-nil. Otherwise, do a lookup in
|
||||
|
|
@ -1527,6 +1546,8 @@ This is USER, if non-nil. Otherwise, do a lookup in
|
|||
result
|
||||
(propertize result 'tramp-default t))))
|
||||
|
||||
(put #'tramp-find-user 'tramp-suppress-trace t)
|
||||
|
||||
(defun tramp-find-host (method user host)
|
||||
"Return the right host string to use depending on METHOD and USER.
|
||||
This is HOST, if non-nil. Otherwise, do a lookup in
|
||||
|
|
@ -1548,6 +1569,8 @@ This is HOST, if non-nil. Otherwise, do a lookup in
|
|||
result
|
||||
(propertize result 'tramp-default t))))
|
||||
|
||||
(put #'tramp-find-host 'tramp-suppress-trace t)
|
||||
|
||||
(defun tramp-dissect-file-name (name &optional nodefault)
|
||||
"Return a `tramp-file-name' structure of NAME, a remote file name.
|
||||
The structure consists of method, user, domain, host, port,
|
||||
|
|
@ -1612,6 +1635,8 @@ default values are used."
|
|||
(tramp-user-error
|
||||
v "Method `%s' is not supported for multi-hops." method)))))))
|
||||
|
||||
(put #'tramp-dissect-file-name 'tramp-suppress-trace t)
|
||||
|
||||
(defun tramp-dissect-hop-name (name &optional nodefault)
|
||||
"Return a `tramp-file-name' structure of `hop' part of NAME.
|
||||
See `tramp-dissect-file-name' for details."
|
||||
|
|
@ -1629,6 +1654,8 @@ See `tramp-dissect-file-name' for details."
|
|||
;; Return result.
|
||||
v))
|
||||
|
||||
(put #'tramp-dissect-hop-name 'tramp-suppress-trace t)
|
||||
|
||||
(defun tramp-buffer-name (vec)
|
||||
"A name for the connection buffer VEC."
|
||||
(let ((method (tramp-file-name-method vec))
|
||||
|
|
@ -1805,6 +1832,8 @@ version, the function does nothing."
|
|||
(format "*debug tramp/%s %s@%s*" method user-domain host-port)
|
||||
(format "*debug tramp/%s %s*" method host-port))))
|
||||
|
||||
(put #'tramp-debug-buffer-name 'tramp-suppress-trace t)
|
||||
|
||||
(defconst tramp-debug-outline-regexp
|
||||
(concat
|
||||
"[[:digit:]]+:[[:digit:]]+:[[:digit:]]+\\.[[:digit:]]+ " ;; Timestamp.
|
||||
|
|
@ -1830,6 +1859,8 @@ Point must be at the beginning of a header line.
|
|||
The outline level is equal to the verbosity of the Tramp message."
|
||||
(1+ (string-to-number (match-string 2))))
|
||||
|
||||
(put #'tramp-debug-outline-level 'tramp-suppress-trace t)
|
||||
|
||||
(defun tramp-get-debug-buffer (vec)
|
||||
"Get the debug buffer for VEC."
|
||||
(with-current-buffer (get-buffer-create (tramp-debug-buffer-name vec))
|
||||
|
|
@ -1855,12 +1886,16 @@ The outline level is equal to the verbosity of the Tramp message."
|
|||
(use-local-map special-mode-map))
|
||||
(current-buffer)))
|
||||
|
||||
(put #'tramp-get-debug-buffer 'tramp-suppress-trace t)
|
||||
|
||||
(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)))
|
||||
|
||||
(put #'tramp-get-debug-file-name 'tramp-suppress-trace t)
|
||||
|
||||
(defun 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
|
||||
|
|
@ -1871,8 +1906,8 @@ ARGUMENTS to actually emit the message (if applicable)."
|
|||
(with-current-buffer (tramp-get-debug-buffer vec)
|
||||
(goto-char (point-max))
|
||||
(let ((point (point)))
|
||||
;; Headline.
|
||||
(when (bobp)
|
||||
;; Headline.
|
||||
(insert
|
||||
(format
|
||||
";; Emacs: %s Tramp: %s -*- mode: outline; coding: utf-8; -*-"
|
||||
|
|
@ -1885,6 +1920,12 @@ ARGUMENTS to actually emit the message (if applicable)."
|
|||
(locate-library "tramp")
|
||||
(or tramp-repository-branch "")
|
||||
(or tramp-repository-version "")))))
|
||||
;; Traces.
|
||||
(when (>= tramp-verbose 11)
|
||||
(dolist (elt (all-completions "tramp-" obarray 'functionp))
|
||||
(let ((fn (intern elt)))
|
||||
(unless (get fn 'tramp-suppress-trace)
|
||||
(trace-function-background fn)))))
|
||||
;; 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)))))
|
||||
|
|
@ -5408,6 +5449,8 @@ Invokes `password-read' if available, `read-passwd' else."
|
|||
;; Reenable the timers.
|
||||
(with-timeout-unsuspend stimers))))
|
||||
|
||||
(put #'tramp-read-passwd 'tramp-suppress-trace t)
|
||||
|
||||
(defun tramp-clear-passwd (vec)
|
||||
"Clear password cache for connection related to VEC."
|
||||
(let ((method (tramp-file-name-method vec))
|
||||
|
|
@ -5422,6 +5465,8 @@ Invokes `password-read' if available, `read-passwd' else."
|
|||
:host ,host-port :port ,method))
|
||||
(password-cache-remove (tramp-make-tramp-file-name vec 'noloc 'nohop))))
|
||||
|
||||
(put #'tramp-clear-passwd 'tramp-suppress-trace t)
|
||||
|
||||
(defun tramp-time-diff (t1 t2)
|
||||
"Return the difference between the two times, in seconds.
|
||||
T1 and T2 are time values (as returned by `current-time' for example)."
|
||||
|
|
|
|||
|
|
@ -195,9 +195,6 @@ is greater than 10.
|
|||
"^error with add-name-to-file")
|
||||
debug-ignored-errors))
|
||||
inhibit-message)
|
||||
(when trace-buffer
|
||||
(dolist (elt (all-completions "tramp-" obarray 'functionp))
|
||||
(trace-function-background (intern elt))))
|
||||
(unwind-protect
|
||||
(let ((tramp--test-instrument-test-case-p t)) ,@body)
|
||||
;; Unwind forms.
|
||||
|
|
@ -205,13 +202,12 @@ is greater than 10.
|
|||
(untrace-all))
|
||||
(when (and (null tramp--test-instrument-test-case-p) (> tramp-verbose 3))
|
||||
(dolist
|
||||
(buf (if trace-buffer
|
||||
(cons (get-buffer trace-buffer) (tramp-list-tramp-buffers))
|
||||
(tramp-list-tramp-buffers)))
|
||||
(buf (append
|
||||
(tramp-list-tramp-buffers)
|
||||
(and trace-buffer (list (get-buffer trace-buffer)))))
|
||||
(with-current-buffer buf
|
||||
(message ";; %s\n%s" buf (buffer-string)))))
|
||||
(when trace-buffer
|
||||
(kill-buffer trace-buffer)))))
|
||||
(message ";; %s\n%s" buf (buffer-string)))
|
||||
(kill-buffer buf))))))
|
||||
|
||||
(defsubst tramp--test-message (fmt-string &rest arguments)
|
||||
"Emit a message into ERT *Messages*."
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue