(require 'tramp)
(declare-function mml-mode "mml")
(declare-function mml-insert-empty-tag "mml")
(declare-function reporter-dump-variable "reporter")
(defvar mm-7bit-chars)
(defvar reporter-eval-buffer)
(defvar reporter-prompt-for-summary-p)
(defun tramp-change-syntax (&optional syntax)
"Change Tramp syntax.
SYNTAX can be one of the symbols `default' (default),
`simplified' (ange-ftp like) or `separate' (XEmacs like)."
(interactive
(let ((input (completing-read
"Enter Tramp syntax: " (tramp-syntax-values) nil t
(symbol-name tramp-syntax))))
(unless (string-empty-p input)
(list (intern input)))))
(when syntax
(customize-set-variable 'tramp-syntax syntax)))
(defun tramp-list-tramp-buffers ()
"Return a list of all Tramp connection buffers."
(append
(all-completions
"*tramp" (mapcar #'list (mapcar #'buffer-name (buffer-list))))
(all-completions
"*debug tramp" (mapcar #'list (mapcar #'buffer-name (buffer-list))))
(all-completions
"*trace tramp" (mapcar #'list (mapcar #'buffer-name (buffer-list))))))
(defun tramp-list-remote-buffers ()
"Return a list of all buffers with remote `default-directory'."
(delq
nil
(mapcar
(lambda (x)
(when (tramp-tramp-file-p (tramp-get-default-directory x)) x))
(buffer-list))))
(defvar tramp-cleanup-connection-hook nil
"List of functions to be called after Tramp connection is cleaned up.
Each function is called with the current vector as argument.")
(defun tramp-cleanup-connection
(vec &optional keep-debug keep-password keep-processes)
"Flush all connection related objects.
This includes password cache, file cache, connection cache,
buffers, processes. KEEP-DEBUG non-nil preserves the debug
buffer. KEEP-PASSWORD non-nil preserves the password cache.
KEEP-PROCESSES non-nil preserves the asynchronous processes.
When called interactively, a Tramp connection has to be selected."
(interactive
(list
(let ((connections
(mapcar #'tramp-make-tramp-file-name (tramp-list-connections)))
name)
(when connections
(setq name
(completing-read
"Enter Tramp connection: " connections nil t
(try-completion "" connections)))
(and (tramp-tramp-file-p name) (tramp-dissect-file-name name))))
nil nil))
(if (not vec)
(message "No Tramp connection found.")
(unless keep-password (tramp-clear-passwd vec))
(setq tramp-current-connection nil)
(dolist (timer timer-list)
(when (and (eq (timer--function timer) 'tramp-timeout-session)
(tramp-file-name-equal-p vec (car (timer--args timer))))
(cancel-timer timer)))
(dolist (key (hash-table-keys tramp-cache-data))
(when (and (processp key)
(tramp-file-name-equal-p (process-get key 'vector) vec)
(or (not keep-processes)
(eq key (tramp-get-process vec))))
(tramp-flush-connection-properties key)
(ignore-errors (delete-process key))))
(dolist
(buf (list (get-buffer (tramp-buffer-name vec))
(unless keep-debug
(get-buffer (tramp-debug-buffer-name vec)))
(unless keep-debug
(get-buffer (tramp-trace-buffer-name vec)))
(tramp-get-connection-property vec "process-buffer")))
(when (bufferp buf) (kill-buffer buf)))
(tramp-flush-directory-properties vec "/")
(tramp-flush-connection-properties vec)
(run-hook-with-args 'tramp-cleanup-connection-hook vec)))
(defun tramp-cleanup-this-connection ()
"Flush all connection related objects of the current buffer's connection."
(interactive)
(and (tramp-tramp-file-p default-directory)
(tramp-cleanup-connection
(tramp-dissect-file-name default-directory 'noexpand))))
(function-put
#'tramp-cleanup-this-connection 'completion-predicate
#'tramp-command-completion-p)
(defvar tramp-cleanup-all-connections-hook nil
"List of functions to be called after all Tramp connections are cleaned up.")
(defun tramp-cleanup-all-connections ()
"Flush all Tramp internal objects.
This includes password cache, file cache, connection cache, buffers."
(interactive)
(password-reset)
(clrhash tramp-cache-data)
(tramp-set-connection-property
tramp-cache-version "tramp-version" tramp-version)
(let ((proxies tramp-default-proxies-alist))
(while proxies
(if (ignore-errors
(get-text-property 0 'tramp-ad-hoc (nth 2 (car proxies))))
(setq tramp-default-proxies-alist
(delete (car proxies) tramp-default-proxies-alist)
proxies tramp-default-proxies-alist)
(setq proxies (cdr proxies)))))
(when (and tramp-default-proxies-alist tramp-save-ad-hoc-proxies)
(customize-save-variable
'tramp-default-proxies-alist tramp-default-proxies-alist))
(cancel-function-timers 'tramp-timeout-session)
(dolist (name (tramp-list-tramp-buffers))
(when (processp (get-buffer-process name)) (delete-process name))
(when (bufferp (get-buffer name)) (kill-buffer name)))
(run-hooks 'tramp-cleanup-all-connections-hook))
(defun tramp-cleanup-all-buffers ()
"Kill all remote buffers."
(interactive)
(tramp-cleanup-all-connections)
(dolist (name (tramp-list-remote-buffers))
(when (bufferp (get-buffer name)) (kill-buffer name))))
(defcustom tramp-default-rename-alist nil
"Default target for renaming remote buffer file names.
This is an alist of cons cells (SOURCE . TARGET). The first
matching item specifies the target to be applied for renaming
buffer file names from source via `tramp-rename-files'. SOURCE
is a regular expressions, which matches a remote file name.
TARGET must be a directory name, which could be remote (including
remote directories Tramp infers by default, such as
\"/method:user@host:\").
TARGET can contain the patterns %m, %u or %h, which are replaced
by the method name, user name or host name of SOURCE when calling
`tramp-rename-files'.
SOURCE could also be a Lisp form, which will be evaluated. The
result must be a string or nil, which is interpreted as a regular
expression which always matches."
:group 'tramp
:version "27.1"
:type '(repeat (cons (choice :tag "Source regexp" regexp sexp)
(choice :tag "Target name" string (const nil)))))
(defcustom tramp-confirm-rename-file-names t
"Whether renaming a buffer file name must be confirmed."
:group 'tramp
:version "27.1"
:type 'boolean)
(defun tramp-default-rename-file (string)
"Determine default file name for renaming according to STRING.
The user option `tramp-default-rename-alist' is consulted,
finding the default mapping. If there is no matching entry, the
function returns nil"
(when (tramp-tramp-file-p string)
(let ((tdra tramp-default-rename-alist)
(method (or (file-remote-p string 'method) ""))
(user (or (file-remote-p string 'user) ""))
(host (or (file-remote-p string 'host) ""))
item result)
(while (setq item (pop tdra))
(when (string-match-p (or (eval (car item) t) "") string)
(setq tdra nil
result
(format-spec
(cdr item) (format-spec-make ?m method ?u user ?h host)))))
result)))
(defsubst tramp-rename-read-file-name-dir (string)
"Return the DIR entry to be applied in `read-file-name', based on STRING."
(when (tramp-tramp-file-p string)
(substring (file-remote-p string) 0 -1)))
(defsubst tramp-rename-read-file-name-init (string)
"Return the INIT entry to be applied in `read-file-name', based on STRING."
(when (tramp-tramp-file-p string)
(string-remove-prefix (tramp-rename-read-file-name-dir string) string)))
(defun tramp-rename-files (source target)
"Replace in all buffers the visiting file name from SOURCE to TARGET.
SOURCE is a remote directory name, which could contain also a
localname part. TARGET is the directory name SOURCE is replaced
with. Often, TARGET is a remote directory name on another host,
but it can also be a local directory name. If TARGET has no
local part, the local part from SOURCE is used.
If TARGET is nil, it is selected according to the first match in
`tramp-default-rename-alist'. If called interactively, this
match is offered as initial value for selection.
On all buffers, which have a `buffer-file-name' matching SOURCE,
this name is modified by replacing SOURCE with TARGET. This is
applied by calling `set-visited-file-name'. The new
`buffer-file-name' is prompted for modification in the
minibuffer. The buffers are marked modified, and must be saved
explicitly.
If user option `tramp-confirm-rename-file-names' is nil, changing
the file name happens without confirmation. This requires a
matching entry in `tramp-default-rename-alist'.
Remote buffers related to the remote connection identified by
SOURCE, which are not visiting files, or which are visiting files
not matching SOURCE, are not modified.
Interactively, TARGET is selected from `tramp-default-rename-alist'
without confirmation if the prefix argument is non-nil.
The remote connection identified by SOURCE is flushed by
`tramp-cleanup-connection'."
(interactive
(let ((connections
(mapcar #'tramp-make-tramp-file-name (tramp-list-connections)))
(completing-read-function #'completing-read-default)
(read-file-name-function #'read-file-name-default)
source target)
(if (null connections)
(tramp-user-error nil "There are no remote connections.")
(setq source
(let (non-essential)
(completing-read-default
"Enter old Tramp connection: "
(completion-table-dynamic
(lambda (string)
(cond
((not (tramp-tramp-file-p string))
(all-completions string connections))
(t (mapcar
(lambda (buffer)
(let ((bfn (buffer-file-name buffer)))
(and (buffer-live-p buffer)
(tramp-equal-remote string bfn)
(stringp bfn) (file-name-directory bfn))))
(tramp-list-remote-buffers))))))
#'tramp-tramp-file-p t
(or (file-remote-p default-directory)
(try-completion "" connections))))
target
(when (null current-prefix-arg)
(let* ((default (or (tramp-default-rename-file source) source))
(dir (tramp-rename-read-file-name-dir default))
(init (tramp-rename-read-file-name-init default))
(tramp-ignored-file-name-regexp
(tramp-compat-rx (literal (file-remote-p source)))))
(read-file-name-default
"Enter new Tramp connection: "
dir default 'confirm init #'file-directory-p)))))
(list source target)))
(unless (tramp-tramp-file-p source)
(tramp-user-error nil "Source %s must be remote." source))
(when (null target)
(or (setq target (tramp-default-rename-file source))
(tramp-user-error
nil
(concat "There is no target specified. "
"Check `tramp-default-rename-alist' for a proper entry."))))
(when (tramp-equal-remote source target)
(tramp-user-error nil "Source and target must have different remote."))
(when (string-equal (file-remote-p target) target)
(setq target (concat target (tramp-file-local-name source))))
(setq source (directory-file-name source)
target (directory-file-name target))
(save-window-excursion
(save-current-buffer
(let ((help-form "\
Type SPC or `y' to set visited file name,
DEL or `n' to skip to next,
`e' to edit the visited file name,
ESC or `q' to quit without changing further buffers,
`!' to change all remaining buffers with no more questions.")
(query-choices '(?y ?\s ?n ?\177 ?! ?e ?q ?\e))
(query (unless tramp-confirm-rename-file-names ?!))
changed-buffers)
(dolist (buffer (tramp-list-remote-buffers))
(switch-to-buffer buffer)
(let* ((bfn (buffer-file-name))
(new-bfn (and (stringp 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)))))
(when (and (buffer-live-p buffer) (stringp bfn)
(string-prefix-p source bfn)
(not (memq query '(?q ?\e))))
(unless (eq query ?!)
(setq query (read-char-choice prompt query-choices)))
(when (eq query ?e)
(setq new-bfn
(read-file-name
"New visited file name: "
(file-name-directory new-bfn) new-bfn)))
(when (memq query '(?y ?\s ?! ?e))
(setq changed-buffers
(cons (list buffer bfn (buffer-modified-p))
changed-buffers))
(set-visited-file-name new-bfn))
(when (and (memq query '(?q ?\e)) changed-buffers
(y-or-n-p "Do you want to revert applied changes?"))
(dolist (item changed-buffers)
(with-current-buffer (car item)
(set-visited-file-name (nth 1 item))
(set-buffer-modified-p (nth 2 item)))))
(message nil)))))))
(tramp-cleanup-connection (tramp-dissect-file-name source)))
(defun tramp-rename-these-files (target)
"Replace visiting file names to TARGET.
The current buffer must be related to a remote connection. In
all buffers, which are visiting a file with the same directory
name, the buffer file name is changed.
Interactively, TARGET is selected from `tramp-default-rename-alist'
without confirmation if the prefix argument is non-nil.
For details, see `tramp-rename-files'."
(interactive
(let ((source default-directory)
target
(completing-read-function #'completing-read-default)
(read-file-name-function #'read-file-name-default))
(if (not (tramp-tramp-file-p source))
(tramp-user-error
nil
(substitute-command-keys
(concat "Current buffer is not remote. "
"Consider `\\[tramp-rename-files]' instead.")))
(setq target
(when (null current-prefix-arg)
(let* ((default (or (tramp-default-rename-file source) source))
(dir (tramp-rename-read-file-name-dir default))
(init (tramp-rename-read-file-name-init default))
(tramp-ignored-file-name-regexp
(tramp-compat-rx (literal (file-remote-p source)))))
(read-file-name-default
(format "Change Tramp connection `%s': " source)
dir default 'confirm init #'file-directory-p)))))
(list target)))
(tramp-rename-files default-directory target))
(function-put
#'tramp-rename-these-files 'completion-predicate #'tramp-command-completion-p)
(defun tramp-recompile-elpa-command-completion-p (_symbol _buffer)
"A predicate for `tramp-recompile-elpa'.
It is completed by \"M-x TAB\" only if package.el is loaded, and
Tramp is an installed ELPA package."
(and (assq 'tramp (bound-and-true-p package-alist))
(tramp-compat-funcall 'package--user-installed-p 'tramp)))
(defun tramp-recompile-elpa ()
"Recompile the installed Tramp ELPA package.
This is needed if there are compatibility problems."
(interactive)
(when-let
((dir (tramp-compat-funcall
'package-desc-dir
(car (alist-get 'tramp (bound-and-true-p package-alist))))))
(dolist (elc (directory-files dir 'full (rx ".elc" eos)))
(delete-file elc))
(with-current-buffer (get-buffer-create byte-compile-log-buffer)
(let ((inhibit-read-only t))
(compilation-mode)
(goto-char (point-max))
(insert "\f\n")
(call-process
(expand-file-name invocation-name invocation-directory) nil t t
"-Q" "-batch" "-L" dir
"--eval" (format "(byte-recompile-directory %S 0 t)" dir))
(message "Package `tramp' recompiled.")))))
(function-put
#'tramp-recompile-elpa 'completion-predicate
#'tramp-recompile-elpa-command-completion-p)
(defun tramp-version (arg)
"Print version number of tramp.el in echo area or current buffer."
(interactive "P")
(if arg (insert tramp-version) (message tramp-version)))
(autoload 'reporter-submit-bug-report "reporter")
(defun tramp-bug ()
"Submit a bug report to the Tramp developers."
(interactive)
(let ((reporter-prompt-for-summary-p t))
(reporter-submit-bug-report
tramp-bug-report-address (format "tramp (%s %s/%s)" tramp-version tramp-repository-branch tramp-repository-version)
(sort
(delq nil (mapcar
(lambda (x)
(and x (boundp x) (not (get x 'tramp-suppress-trace))
(cons x 'tramp-reporter-dump-variable)))
(append
(mapcar #'intern (all-completions "tramp-" obarray #'boundp))
'(shell-prompt-pattern
backup-by-copying
backup-by-copying-when-linked
backup-by-copying-when-mismatch
backup-by-copying-when-privileged-mismatch
backup-directory-alist
password-cache
password-cache-expiry
remote-file-name-inhibit-cache
connection-local-profile-alist
connection-local-criteria-alist
file-name-handler-alist))))
(lambda (x y) (string< (symbol-name (car x)) (symbol-name (car y)))))
'tramp-load-report-modules 'tramp-append-tramp-buffers (propertize
"\n" 'display "\
Enter your bug report in this message, including as much detail
as you possibly can about the problem, what you did to cause it
and what the local and remote machines are.
If you can give a simple set of instructions to make this bug
happen reliably, please include those. Thank you for helping
kill bugs in Tramp.
Before reproducing the bug, you might apply
M-x tramp-cleanup-all-connections
This allows us to investigate from a clean environment. Another
useful thing to do is to put
(setq tramp-verbose 9)
in your init file and to repeat the bug. Then, include the
contents of the *tramp/foo* buffer and the *debug tramp/foo*
buffer in your bug report.
--bug report follows this line--
"))))
(defun tramp-reporter-dump-variable (varsym mailbuf)
"Pretty-print the value of the variable in symbol VARSYM."
(when-let ((reporter-eval-buffer reporter-eval-buffer)
(val (buffer-local-value varsym reporter-eval-buffer)))
(if (hash-table-p val)
(set varsym (read (format "(%s)" (tramp-cache-print val))))
(when (and (stringp val)
(string-match-p
(rx-to-string `(not (any ,mm-7bit-chars))) val))
(with-current-buffer reporter-eval-buffer
(set varsym
`(decode-coding-string
(base64-decode-string
,(base64-encode-string (encode-coding-string val 'raw-text)))
'raw-text)))))
(goto-char (point-max))
(save-excursion
(reporter-dump-variable varsym mailbuf))
(unless (hash-table-p val)
(when (looking-at
(tramp-compat-rx
bol (group (* anychar)) "\"" (group "(base64-decode-string ") "\\" (group "\"" (* anychar)) "\\" (group "\")") "\"" eol)) (replace-match "\\1\\2\\3\\4")
(beginning-of-line)
(insert " ;; Variable encoded due to non-printable characters.\n")))
(goto-char (point-max))
(with-current-buffer reporter-eval-buffer
(set varsym val))))
(defun tramp-load-report-modules ()
"Load needed modules for reporting."
(message-mode)
(mml-mode t))
(defun tramp-append-tramp-buffers ()
"Append Tramp buffers and buffer local variables into the bug report."
(goto-char (point-max))
(insert "\nlocal variables:\n================")
(dolist (buffer
(delq nil
(mapcar
(lambda (b)
(when (string-match-p "\\*tramp/" (buffer-name b)) b))
(buffer-list))))
(let ((reporter-eval-buffer buffer)
(elbuf (get-buffer-create " *tmp-reporter-buffer*")))
(with-current-buffer elbuf
(emacs-lisp-mode)
(erase-buffer)
(insert (format "\n;; %s\n(setq-local\n" (buffer-name buffer)))
(lisp-indent-line)
(dolist (varsym
(sort
(append
(mapcar
#'intern
(all-completions "tramp-" (buffer-local-variables buffer)))
'(connection-local-variables-alist default-directory))
#'string<))
(reporter-dump-variable varsym elbuf))
(lisp-indent-line)
(insert ")\n"))
(insert-buffer-substring elbuf)))
(goto-char (point-min))
(while (re-search-forward
(rx "'" (group "(decode-coding-string")) nil 'noerror)
(replace-match "\\1"))
(goto-char (point-max))
(insert "\nload-path shadows:\n==================\n")
(ignore-errors
(mapc
(lambda (x) (when (tramp-compat-string-search "tramp" x) (insert x "\n")))
(split-string (list-load-path-shadows t) "\n")))
(when (and
(eq major-mode 'message-mode)
(bound-and-true-p mml-mode))
(let ((tramp-buf-regexp (rx "*" (? "debug ") "tramp/"))
(buffer-list (tramp-list-tramp-buffers))
(curbuf (current-buffer)))
(when buffer-list
(switch-to-buffer (list-buffers-noselect nil))
(delete-other-windows)
(setq buffer-read-only nil)
(goto-char (point-min))
(while (not (eobp))
(if (re-search-forward tramp-buf-regexp (line-end-position) t)
(forward-line 1)
(forward-line 0)
(let ((start (point)))
(forward-line 1)
(kill-region start (point)))))
(insert "
The buffer(s) above will be appended to this message. If you
don't want to append a buffer because it contains sensitive data,
or because the buffer is too large, you should delete the
respective buffer. The buffer(s) will contain user and host
names. Passwords will never be included there.")
(when (>= tramp-verbose 6)
(insert "\n\n")
(let ((start (point)))
(insert "\
Please note that you have set `tramp-verbose' to a value of at
least 6. Therefore, the contents of files might be included in
the debug buffer(s).")
(add-text-properties start (point) '(face italic))))
(set-buffer-modified-p nil)
(setq buffer-read-only t)
(goto-char (point-min))
(when (y-or-n-p "Do you want to append the buffer(s)?")
(kill-buffer)
(switch-to-buffer curbuf)
(goto-char (point-max))
(insert (propertize "\n" 'display "\n\
This is a special notion of the `gnus/message' package. If you
use another mail agent (by copying the contents of this buffer)
please ensure that the buffers are attached to your email.\n\n"))
(dolist (buffer buffer-list)
(mml-insert-empty-tag
'part 'type "text/plain"
'encoding "base64" 'disposition "attachment" 'buffer buffer
'description buffer))
(set-buffer-modified-p nil))))))
(defalias 'tramp-submit-bug #'tramp-bug)
(add-hook 'tramp-unload-hook
(lambda () (unload-feature 'tramp-cmds 'force)))
(provide 'tramp-cmds)