From: Michael Albinus Date: Tue, 1 Dec 2020 12:37:03 +0000 (+0100) Subject: Allow Tramp to mirror traces to a file X-Git-Tag: emacs-28.0.90~4982 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=ba692b790da79cde98932295362a5de138991d47;p=emacs.git 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. --- diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index f853c6d7af9..59b8bdbdf37 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 51cb316249d..4947d161f3f 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 827d5f60a2b..622116d9f90 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 7fae9ba7e2f..b44eabcfa8b 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 098fba56b5b..40a7cbbce19 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 2851110826c..1ce6542d1a7 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 cafa97cec09..e5213713320 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 6ae79be9e35..c367182057a 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)