aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMichael Albinus2021-05-07 13:04:28 +0200
committerMichael Albinus2021-05-07 13:04:28 +0200
commit70bfcbcdd328775d0fcac5ec06b797e227fc032a (patch)
tree20fb2b7bd138022b9bf1cb50fc264a74119443d9
parent704755a568300985caa9e143f46f17d364e5eda9 (diff)
downloademacs-70bfcbcdd328775d0fcac5ec06b797e227fc032a.tar.gz
emacs-70bfcbcdd328775d0fcac5ec06b797e227fc032a.zip
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.
-rw-r--r--doc/misc/tramp.texi18
-rw-r--r--lisp/net/tramp-compat.el5
-rw-r--r--lisp/net/tramp.el49
-rw-r--r--test/lisp/net/tramp-tests.el14
4 files changed, 58 insertions, 28 deletions
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index ebfc14d9368..47beb90e6c6 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -5336,6 +5336,7 @@ The verbosity levels are
5336@*@indent @w{ 8} connection properties 5336@*@indent @w{ 8} connection properties
5337@*@indent @w{ 9} test commands 5337@*@indent @w{ 9} test commands
5338@*@indent @w{10} traces (huge) 5338@*@indent @w{10} traces (huge)
5339@*@indent @w{11} call traces (maintainer only)
5339 5340
5340With @code{tramp-verbose} greater than or equal to 4, messages are 5341With @code{tramp-verbose} greater than or equal to 4, messages are
5341also written to a @value{tramp} debug buffer. Such debug buffers are 5342also 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
5384this option with care, because it could decrease the performance of 5385this option with care, because it could decrease the performance of
5385@value{tramp} actions. 5386@value{tramp} actions.
5386 5387
5387To enable stepping through @value{tramp} function call traces, they 5388If @code{tramp-verbose} is greater than or equal to 11, @value{tramp}
5388have to be specifically enabled as shown in this code: 5389function call traces are written to the buffer @file{*trace-output*}.
5389
5390@lisp
5391@group
5392(require 'trace)
5393(dolist (elt (all-completions "tramp-" obarray 'functionp))
5394 (trace-function-background (intern elt)))
5395(untrace-function 'tramp-read-passwd)
5396@end group
5397@end lisp
5398
5399The buffer @file{*trace-output*} contains the output from the function
5400call traces. Disable @code{tramp-read-passwd} to stop password
5401strings from being written to @file{*trace-output*}.
5402 5390
5403 5391
5404@node GNU Free Documentation License 5392@node GNU Free Documentation License
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index b67de1bd21b..54cfb6fb4a4 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -63,8 +63,6 @@
63 `(when (functionp ,function) 63 `(when (functionp ,function)
64 (with-no-warnings (funcall ,function ,@arguments)))) 64 (with-no-warnings (funcall ,function ,@arguments))))
65 65
66(put #'tramp-compat-funcall 'tramp-suppress-trace t)
67
68(defsubst tramp-compat-temporary-file-directory () 66(defsubst tramp-compat-temporary-file-directory ()
69 "Return name of directory for temporary files. 67 "Return name of directory for temporary files.
70It is the default value of `temporary-file-directory'." 68It is the default value of `temporary-file-directory'."
@@ -355,6 +353,9 @@ A nil value for either argument stands for the current time."
355 (lambda (fromstring tostring instring) 353 (lambda (fromstring tostring instring)
356 (replace-regexp-in-string (regexp-quote fromstring) tostring instring)))) 354 (replace-regexp-in-string (regexp-quote fromstring) tostring instring))))
357 355
356(dolist (elt (all-completions "tramp-compat-" obarray 'functionp))
357 (put (intern elt) 'tramp-suppress-trace t))
358
358(add-hook 'tramp-unload-hook 359(add-hook 'tramp-unload-hook
359 (lambda () 360 (lambda ()
360 (unload-feature 'tramp-loaddefs 'force) 361 (unload-feature 'tramp-loaddefs 'force)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 741ea05ceaf..9fec1514221 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -109,7 +109,8 @@ Any level x includes messages for all levels 1 .. x-1. The levels are
109 7 file caching 109 7 file caching
110 8 connection properties 110 8 connection properties
111 9 test commands 111 9 test commands
11210 traces (huge)." 11210 traces (huge)
11311 call traces (maintainer only)."
113 :type 'integer) 114 :type 'integer)
114 115
115(defcustom tramp-debug-to-file nil 116(defcustom tramp-debug-to-file nil
@@ -1390,6 +1391,14 @@ calling HANDLER.")
1390(cl-defstruct (tramp-file-name (:type list) :named) 1391(cl-defstruct (tramp-file-name (:type list) :named)
1391 method user domain host port localname hop) 1392 method user domain host port localname hop)
1392 1393
1394(put #'tramp-file-name-method 'tramp-suppress-trace t)
1395(put #'tramp-file-name-user 'tramp-suppress-trace t)
1396(put #'tramp-file-name-domain 'tramp-suppress-trace t)
1397(put #'tramp-file-name-host 'tramp-suppress-trace t)
1398(put #'tramp-file-name-port 'tramp-suppress-trace t)
1399(put #'tramp-file-name-localname 'tramp-suppress-trace t)
1400(put #'tramp-file-name-hop 'tramp-suppress-trace t)
1401
1393(defun tramp-file-name-user-domain (vec) 1402(defun tramp-file-name-user-domain (vec)
1394 "Return user and domain components of VEC." 1403 "Return user and domain components of VEC."
1395 (when (or (tramp-file-name-user vec) (tramp-file-name-domain vec)) 1404 (when (or (tramp-file-name-user vec) (tramp-file-name-domain vec))
@@ -1398,6 +1407,8 @@ calling HANDLER.")
1398 tramp-prefix-domain-format) 1407 tramp-prefix-domain-format)
1399 (tramp-file-name-domain vec)))) 1408 (tramp-file-name-domain vec))))
1400 1409
1410(put #'tramp-file-name-user-domain 'tramp-suppress-trace t)
1411
1401(defun tramp-file-name-host-port (vec) 1412(defun tramp-file-name-host-port (vec)
1402 "Return host and port components of VEC." 1413 "Return host and port components of VEC."
1403 (when (or (tramp-file-name-host vec) (tramp-file-name-port vec)) 1414 (when (or (tramp-file-name-host vec) (tramp-file-name-port vec))
@@ -1406,12 +1417,16 @@ calling HANDLER.")
1406 tramp-prefix-port-format) 1417 tramp-prefix-port-format)
1407 (tramp-file-name-port vec)))) 1418 (tramp-file-name-port vec))))
1408 1419
1420(put #'tramp-file-name-host-port 'tramp-suppress-trace t)
1421
1409(defun tramp-file-name-port-or-default (vec) 1422(defun tramp-file-name-port-or-default (vec)
1410 "Return port component of VEC. 1423 "Return port component of VEC.
1411If nil, return `tramp-default-port'." 1424If nil, return `tramp-default-port'."
1412 (or (tramp-file-name-port vec) 1425 (or (tramp-file-name-port vec)
1413 (tramp-get-method-parameter vec 'tramp-default-port))) 1426 (tramp-get-method-parameter vec 'tramp-default-port)))
1414 1427
1428(put #'tramp-file-name-port-or-default 'tramp-suppress-trace t)
1429
1415;; Comparison of file names is performed by `tramp-equal-remote'. 1430;; Comparison of file names is performed by `tramp-equal-remote'.
1416(defun tramp-file-name-equal-p (vec1 vec2) 1431(defun tramp-file-name-equal-p (vec1 vec2)
1417 "Check, whether VEC1 and VEC2 denote the same `tramp-file-name'." 1432 "Check, whether VEC1 and VEC2 denote the same `tramp-file-name'."
@@ -1458,6 +1473,8 @@ entry does not exist, return nil."
1458 (string-match-p tramp-file-name-regexp name) 1473 (string-match-p tramp-file-name-regexp name)
1459 t)) 1474 t))
1460 1475
1476(put #'tramp-tramp-file-p 'tramp-suppress-trace t)
1477
1461;; This function bypasses the file name handler approach. It is NOT 1478;; This function bypasses the file name handler approach. It is NOT
1462;; recommended to use it in any package if not absolutely necessary. 1479;; recommended to use it in any package if not absolutely necessary.
1463;; However, it is more performant than `file-local-name', and might be 1480;; 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
1506 result 1523 result
1507 (propertize result 'tramp-default t)))) 1524 (propertize result 'tramp-default t))))
1508 1525
1526(put #'tramp-find-method 'tramp-suppress-trace t)
1527
1509(defun tramp-find-user (method user host) 1528(defun tramp-find-user (method user host)
1510 "Return the right user string to use depending on METHOD and HOST. 1529 "Return the right user string to use depending on METHOD and HOST.
1511This is USER, if non-nil. Otherwise, do a lookup in 1530This 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
1527 result 1546 result
1528 (propertize result 'tramp-default t)))) 1547 (propertize result 'tramp-default t))))
1529 1548
1549(put #'tramp-find-user 'tramp-suppress-trace t)
1550
1530(defun tramp-find-host (method user host) 1551(defun tramp-find-host (method user host)
1531 "Return the right host string to use depending on METHOD and USER. 1552 "Return the right host string to use depending on METHOD and USER.
1532This is HOST, if non-nil. Otherwise, do a lookup in 1553This 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
1548 result 1569 result
1549 (propertize result 'tramp-default t)))) 1570 (propertize result 'tramp-default t))))
1550 1571
1572(put #'tramp-find-host 'tramp-suppress-trace t)
1573
1551(defun tramp-dissect-file-name (name &optional nodefault) 1574(defun tramp-dissect-file-name (name &optional nodefault)
1552 "Return a `tramp-file-name' structure of NAME, a remote file name. 1575 "Return a `tramp-file-name' structure of NAME, a remote file name.
1553The structure consists of method, user, domain, host, port, 1576The structure consists of method, user, domain, host, port,
@@ -1612,6 +1635,8 @@ default values are used."
1612 (tramp-user-error 1635 (tramp-user-error
1613 v "Method `%s' is not supported for multi-hops." method))))))) 1636 v "Method `%s' is not supported for multi-hops." method)))))))
1614 1637
1638(put #'tramp-dissect-file-name 'tramp-suppress-trace t)
1639
1615(defun tramp-dissect-hop-name (name &optional nodefault) 1640(defun tramp-dissect-hop-name (name &optional nodefault)
1616 "Return a `tramp-file-name' structure of `hop' part of NAME. 1641 "Return a `tramp-file-name' structure of `hop' part of NAME.
1617See `tramp-dissect-file-name' for details." 1642See `tramp-dissect-file-name' for details."
@@ -1629,6 +1654,8 @@ See `tramp-dissect-file-name' for details."
1629 ;; Return result. 1654 ;; Return result.
1630 v)) 1655 v))
1631 1656
1657(put #'tramp-dissect-hop-name 'tramp-suppress-trace t)
1658
1632(defun tramp-buffer-name (vec) 1659(defun tramp-buffer-name (vec)
1633 "A name for the connection buffer VEC." 1660 "A name for the connection buffer VEC."
1634 (let ((method (tramp-file-name-method vec)) 1661 (let ((method (tramp-file-name-method vec))
@@ -1805,6 +1832,8 @@ version, the function does nothing."
1805 (format "*debug tramp/%s %s@%s*" method user-domain host-port) 1832 (format "*debug tramp/%s %s@%s*" method user-domain host-port)
1806 (format "*debug tramp/%s %s*" method host-port)))) 1833 (format "*debug tramp/%s %s*" method host-port))))
1807 1834
1835(put #'tramp-debug-buffer-name 'tramp-suppress-trace t)
1836
1808(defconst tramp-debug-outline-regexp 1837(defconst tramp-debug-outline-regexp
1809 (concat 1838 (concat
1810 "[[:digit:]]+:[[:digit:]]+:[[:digit:]]+\\.[[:digit:]]+ " ;; Timestamp. 1839 "[[:digit:]]+:[[:digit:]]+:[[:digit:]]+\\.[[:digit:]]+ " ;; Timestamp.
@@ -1830,6 +1859,8 @@ Point must be at the beginning of a header line.
1830The outline level is equal to the verbosity of the Tramp message." 1859The outline level is equal to the verbosity of the Tramp message."
1831 (1+ (string-to-number (match-string 2)))) 1860 (1+ (string-to-number (match-string 2))))
1832 1861
1862(put #'tramp-debug-outline-level 'tramp-suppress-trace t)
1863
1833(defun tramp-get-debug-buffer (vec) 1864(defun tramp-get-debug-buffer (vec)
1834 "Get the debug buffer for VEC." 1865 "Get the debug buffer for VEC."
1835 (with-current-buffer (get-buffer-create (tramp-debug-buffer-name vec)) 1866 (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."
1855 (use-local-map special-mode-map)) 1886 (use-local-map special-mode-map))
1856 (current-buffer))) 1887 (current-buffer)))
1857 1888
1889(put #'tramp-get-debug-buffer 'tramp-suppress-trace t)
1890
1858(defun tramp-get-debug-file-name (vec) 1891(defun tramp-get-debug-file-name (vec)
1859 "Get the debug buffer for VEC." 1892 "Get the debug buffer for VEC."
1860 (expand-file-name 1893 (expand-file-name
1861 (tramp-compat-string-replace "/" " " (tramp-debug-buffer-name vec)) 1894 (tramp-compat-string-replace "/" " " (tramp-debug-buffer-name vec))
1862 (tramp-compat-temporary-file-directory))) 1895 (tramp-compat-temporary-file-directory)))
1863 1896
1897(put #'tramp-get-debug-file-name 'tramp-suppress-trace t)
1898
1864(defun tramp-debug-message (vec fmt-string &rest arguments) 1899(defun tramp-debug-message (vec fmt-string &rest arguments)
1865 "Append message to debug buffer of VEC. 1900 "Append message to debug buffer of VEC.
1866Message is formatted with FMT-STRING as control string and the remaining 1901Message is formatted with FMT-STRING as control string and the remaining
@@ -1871,8 +1906,8 @@ ARGUMENTS to actually emit the message (if applicable)."
1871 (with-current-buffer (tramp-get-debug-buffer vec) 1906 (with-current-buffer (tramp-get-debug-buffer vec)
1872 (goto-char (point-max)) 1907 (goto-char (point-max))
1873 (let ((point (point))) 1908 (let ((point (point)))
1874 ;; Headline.
1875 (when (bobp) 1909 (when (bobp)
1910 ;; Headline.
1876 (insert 1911 (insert
1877 (format 1912 (format
1878 ";; Emacs: %s Tramp: %s -*- mode: outline; coding: utf-8; -*-" 1913 ";; Emacs: %s Tramp: %s -*- mode: outline; coding: utf-8; -*-"
@@ -1885,6 +1920,12 @@ ARGUMENTS to actually emit the message (if applicable)."
1885 (locate-library "tramp") 1920 (locate-library "tramp")
1886 (or tramp-repository-branch "") 1921 (or tramp-repository-branch "")
1887 (or tramp-repository-version ""))))) 1922 (or tramp-repository-version "")))))
1923 ;; Traces.
1924 (when (>= tramp-verbose 11)
1925 (dolist (elt (all-completions "tramp-" obarray 'functionp))
1926 (let ((fn (intern elt)))
1927 (unless (get fn 'tramp-suppress-trace)
1928 (trace-function-background fn)))))
1888 ;; Delete debug file. 1929 ;; Delete debug file.
1889 (when (and tramp-debug-to-file (tramp-get-debug-file-name vec)) 1930 (when (and tramp-debug-to-file (tramp-get-debug-file-name vec))
1890 (ignore-errors (delete-file (tramp-get-debug-file-name vec))))) 1931 (ignore-errors (delete-file (tramp-get-debug-file-name vec)))))
@@ -5408,6 +5449,8 @@ Invokes `password-read' if available, `read-passwd' else."
5408 ;; Reenable the timers. 5449 ;; Reenable the timers.
5409 (with-timeout-unsuspend stimers)))) 5450 (with-timeout-unsuspend stimers))))
5410 5451
5452(put #'tramp-read-passwd 'tramp-suppress-trace t)
5453
5411(defun tramp-clear-passwd (vec) 5454(defun tramp-clear-passwd (vec)
5412 "Clear password cache for connection related to VEC." 5455 "Clear password cache for connection related to VEC."
5413 (let ((method (tramp-file-name-method vec)) 5456 (let ((method (tramp-file-name-method vec))
@@ -5422,6 +5465,8 @@ Invokes `password-read' if available, `read-passwd' else."
5422 :host ,host-port :port ,method)) 5465 :host ,host-port :port ,method))
5423 (password-cache-remove (tramp-make-tramp-file-name vec 'noloc 'nohop)))) 5466 (password-cache-remove (tramp-make-tramp-file-name vec 'noloc 'nohop))))
5424 5467
5468(put #'tramp-clear-passwd 'tramp-suppress-trace t)
5469
5425(defun tramp-time-diff (t1 t2) 5470(defun tramp-time-diff (t1 t2)
5426 "Return the difference between the two times, in seconds. 5471 "Return the difference between the two times, in seconds.
5427T1 and T2 are time values (as returned by `current-time' for example)." 5472T1 and T2 are time values (as returned by `current-time' for example)."
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 3a199469d6b..0f6f3b79800 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -195,9 +195,6 @@ is greater than 10.
195 "^error with add-name-to-file") 195 "^error with add-name-to-file")
196 debug-ignored-errors)) 196 debug-ignored-errors))
197 inhibit-message) 197 inhibit-message)
198 (when trace-buffer
199 (dolist (elt (all-completions "tramp-" obarray 'functionp))
200 (trace-function-background (intern elt))))
201 (unwind-protect 198 (unwind-protect
202 (let ((tramp--test-instrument-test-case-p t)) ,@body) 199 (let ((tramp--test-instrument-test-case-p t)) ,@body)
203 ;; Unwind forms. 200 ;; Unwind forms.
@@ -205,13 +202,12 @@ is greater than 10.
205 (untrace-all)) 202 (untrace-all))
206 (when (and (null tramp--test-instrument-test-case-p) (> tramp-verbose 3)) 203 (when (and (null tramp--test-instrument-test-case-p) (> tramp-verbose 3))
207 (dolist 204 (dolist
208 (buf (if trace-buffer 205 (buf (append
209 (cons (get-buffer trace-buffer) (tramp-list-tramp-buffers)) 206 (tramp-list-tramp-buffers)
210 (tramp-list-tramp-buffers))) 207 (and trace-buffer (list (get-buffer trace-buffer)))))
211 (with-current-buffer buf 208 (with-current-buffer buf
212 (message ";; %s\n%s" buf (buffer-string))))) 209 (message ";; %s\n%s" buf (buffer-string)))
213 (when trace-buffer 210 (kill-buffer buf))))))
214 (kill-buffer trace-buffer)))))
215 211
216(defsubst tramp--test-message (fmt-string &rest arguments) 212(defsubst tramp--test-message (fmt-string &rest arguments)
217 "Emit a message into ERT *Messages*." 213 "Emit a message into ERT *Messages*."