From 70bfcbcdd328775d0fcac5ec06b797e227fc032a Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 7 May 2021 13:04:28 +0200 Subject: [PATCH] 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. --- doc/misc/tramp.texi | 18 +++---------- lisp/net/tramp-compat.el | 5 ++-- lisp/net/tramp.el | 49 ++++++++++++++++++++++++++++++++++-- test/lisp/net/tramp-tests.el | 14 ++++------- 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 @*@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 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 @@ `(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) 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 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)." 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. "^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*." -- 2.39.2