1 ;;; tramp-cmds.el --- Interactive commands for Tramp -*- lexical-binding:t -*-
3 ;; Copyright (C) 2007-2018 Free Software Foundation, Inc.
5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
6 ;; Keywords: comm, processes
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
26 ;; This package provides all interactive commands which are related
33 ;; Pacify byte-compiler.
34 (declare-function mml-mode
"mml")
35 (declare-function mml-insert-empty-tag
"mml")
36 (declare-function reporter-dump-variable
"reporter")
37 (defvar reporter-eval-buffer
)
38 (defvar reporter-prompt-for-summary-p
)
41 (defun tramp-change-syntax (&optional syntax
)
43 SYNTAX can be one of the symbols `default' (default),
44 `simplified' (ange-ftp like) or `separate' (XEmacs like)."
46 (let ((input (completing-read
47 "Enter Tramp syntax: " (tramp-syntax-values) nil t
48 (symbol-name tramp-syntax
))))
49 (unless (string-equal input
"")
50 (list (intern input
)))))
52 (customize-set-variable 'tramp-syntax syntax
)))
54 (defun tramp-list-tramp-buffers ()
55 "Return a list of all Tramp connection buffers."
58 "*tramp" (mapcar 'list
(mapcar 'buffer-name
(buffer-list))))
60 "*debug tramp" (mapcar 'list
(mapcar 'buffer-name
(buffer-list))))))
62 (defun tramp-list-remote-buffers ()
63 "Return a list of all buffers with remote default-directory."
68 (with-current-buffer x
(when (tramp-tramp-file-p default-directory
) x
)))
72 (defun tramp-cleanup-connection (vec &optional keep-debug keep-password
)
73 "Flush all connection related objects.
74 This includes password cache, file cache, connection cache,
75 buffers. KEEP-DEBUG non-nil preserves the debug buffer.
76 KEEP-PASSWORD non-nil preserves the password cache.
77 When called interactively, a Tramp connection has to be selected."
79 ;; When interactive, select the Tramp remote identification.
80 ;; Return nil when there is no Tramp connection.
83 (mapcar 'tramp-make-tramp-file-name
(tramp-list-connections)))
89 "Enter Tramp connection: " connections nil t
90 (try-completion "" connections
)))
91 (and (tramp-tramp-file-p name
) (tramp-dissect-file-name name
))))
96 (message "No Tramp connection found.")
98 ;; Flush password cache.
99 (unless keep-password
(tramp-clear-passwd vec
))
101 ;; Cleanup `tramp-current-connection'. Otherwise, we would be
102 ;; suppressed in the test suite. We use `keep-password' as
103 ;; indicator; it is not worth to add a new argument.
104 (when keep-password
(setq tramp-current-connection nil
))
107 (tramp-flush-directory-properties vec
"")
109 ;; Flush connection cache.
110 (when (processp (tramp-get-connection-process vec
))
111 (tramp-flush-connection-properties (tramp-get-connection-process vec
))
112 (delete-process (tramp-get-connection-process vec
)))
113 (tramp-flush-connection-properties vec
)
117 (buf (list (get-buffer (tramp-buffer-name vec
))
119 (get-buffer (tramp-debug-buffer-name vec
)))
120 (tramp-get-connection-property vec
"process-buffer" nil
)))
121 (when (bufferp buf
) (kill-buffer buf
)))))
124 (defun tramp-cleanup-this-connection ()
125 "Flush all connection related objects of the current buffer's connection."
127 (and (tramp-tramp-file-p default-directory
)
128 (tramp-cleanup-connection
129 (tramp-dissect-file-name default-directory
'noexpand
))))
132 (defun tramp-cleanup-all-connections ()
133 "Flush all Tramp internal objects.
134 This includes password cache, file cache, connection cache, buffers."
138 (setq tramp-locked nil
)
140 ;; Flush password cache.
143 ;; Flush file and connection cache.
144 (clrhash tramp-cache-data
)
146 ;; Cleanup local copies of archives.
147 (when (bound-and-true-p tramp-archive-enabled
)
148 (tramp-archive-cleanup-hash))
151 (dolist (name (tramp-list-tramp-buffers))
152 (when (bufferp (get-buffer name
)) (kill-buffer name
))))
155 (defun tramp-cleanup-all-buffers ()
156 "Kill all remote buffers."
159 ;; Remove all Tramp related connections.
160 (tramp-cleanup-all-connections)
162 ;; Remove all buffers with a remote default-directory.
163 (dolist (name (tramp-list-remote-buffers))
164 (when (bufferp (get-buffer name
)) (kill-buffer name
))))
166 ;; Tramp version is useful in a number of situations.
169 (defun tramp-version (arg)
170 "Print version number of tramp.el in minibuffer or current buffer."
172 (if arg
(insert tramp-version
) (message tramp-version
)))
174 ;; Make the "reporter" functionality available for making bug reports about
175 ;; the package. A most useful piece of code.
177 (autoload 'reporter-submit-bug-report
"reporter")
181 "Submit a bug report to the Tramp developers."
184 (let ((reporter-prompt-for-summary-p t
)
185 ;; In rare cases, it could contain the password. So we make it nil.
186 tramp-password-save-function
)
187 (reporter-submit-bug-report
188 tramp-bug-report-address
; to-address
189 (format "tramp (%s)" tramp-version
) ; package name and version
193 (and x
(boundp x
) (cons x
'tramp-reporter-dump-variable
)))
195 (mapcar 'intern
(all-completions "tramp-" obarray
'boundp
))
196 ;; Non-tramp variables of interest.
197 '(shell-prompt-pattern
199 backup-by-copying-when-linked
200 backup-by-copying-when-mismatch
201 backup-by-copying-when-privileged-mismatch
202 backup-directory-alist
204 password-cache-expiry
205 remote-file-name-inhibit-cache
206 connection-local-profile-alist
207 connection-local-criteria-alist
208 file-name-handler-alist
))))
209 (lambda (x y
) (string< (symbol-name (car x
)) (symbol-name (car y
)))))
211 'tramp-load-report-modules
; pre-hook
212 'tramp-append-tramp-buffers
; post-hook
215 Enter your bug report in this message, including as much detail
216 as you possibly can about the problem, what you did to cause it
217 and what the local and remote machines are.
219 If you can give a simple set of instructions to make this bug
220 happen reliably, please include those. Thank you for helping
223 Before reproducing the bug, you might apply
225 M-x tramp-cleanup-all-connections
227 This allows us to investigate from a clean environment. Another
228 useful thing to do is to put
230 (setq tramp-verbose 9)
232 in your init file and to repeat the bug. Then, include the
233 contents of the *tramp/foo* buffer and the *debug tramp/foo*
234 buffer in your bug report.
236 --bug report follows this line--
239 (defun tramp-reporter-dump-variable (varsym mailbuf
)
240 "Pretty-print the value of the variable in symbol VARSYM."
241 (let* ((reporter-eval-buffer (symbol-value 'reporter-eval-buffer
))
242 (val (with-current-buffer reporter-eval-buffer
243 (symbol-value varsym
))))
245 (if (hash-table-p val
)
246 ;; Pretty print the cache.
247 (set varsym
(read (format "(%s)" (tramp-cache-print val
))))
248 ;; There are non-7bit characters to be masked.
249 (when (and (stringp val
)
251 (concat "[^" (bound-and-true-p mm-7bit-chars
) "]") val
))
252 (with-current-buffer reporter-eval-buffer
256 "(decode-coding-string (base64-decode-string \"%s\") 'raw-text)"
257 (base64-encode-string (encode-coding-string val
'raw-text
)))))))
260 (reporter-dump-variable varsym mailbuf
)
262 (unless (hash-table-p val
)
263 ;; Remove string quotation.
266 (concat "\\(^.*\\)" "\"" ;; \1 "
267 "\\((base64-decode-string \\)" "\\\\" ;; \2 \
268 "\\(\".*\\)" "\\\\" ;; \3 \
269 "\\(\")\\)" "\"$")) ;; \4 "
270 (replace-match "\\1\\2\\3\\4")
272 (insert " ;; Variable encoded due to non-printable characters.\n"))
275 ;; Reset VARSYM to old value.
276 (with-current-buffer reporter-eval-buffer
279 (defun tramp-load-report-modules ()
280 "Load needed modules for reporting."
284 (defun tramp-append-tramp-buffers ()
285 "Append Tramp buffers and buffer local variables into the bug report."
286 (goto-char (point-max))
288 ;; Dump buffer local variables.
289 (insert "\nlocal variables:\n================")
294 (when (string-match "\\*tramp/" (buffer-name b
)) b
))
296 (let ((reporter-eval-buffer buffer
)
297 (elbuf (get-buffer-create " *tmp-reporter-buffer*")))
298 (with-current-buffer elbuf
301 (insert (format "\n;; %s\n(setq-local\n" (buffer-name buffer
)))
309 (all-completions "tramp-" (buffer-local-variables buffer
)))
310 ;; Non-tramp variables of interest.
311 '(connection-local-variables-alist default-directory
))
313 (reporter-dump-variable varsym elbuf
))
316 (insert-buffer-substring elbuf
)))
318 ;; Dump load-path shadows.
319 (insert "\nload-path shadows:\n==================\n")
322 (lambda (x) (when (string-match "tramp" x
) (insert x
"\n")))
323 (split-string (list-load-path-shadows t
) "\n")))
325 ;; Append buffers only when we are in message mode.
327 (eq major-mode
'message-mode
)
328 (bound-and-true-p mml-mode
))
330 (let ((tramp-buf-regexp "\\*\\(debug \\)?tramp/")
331 (buffer-list (tramp-list-tramp-buffers))
332 (curbuf (current-buffer)))
334 ;; There is at least one Tramp buffer.
336 (switch-to-buffer (list-buffers-noselect nil
))
337 (delete-other-windows)
338 (setq buffer-read-only nil
)
339 (goto-char (point-min))
341 (if (re-search-forward tramp-buf-regexp
(point-at-eol) t
)
344 (let ((start (point)))
346 (kill-region start
(point)))))
348 The buffer(s) above will be appended to this message. If you
349 don't want to append a buffer because it contains sensitive data,
350 or because the buffer is too large, you should delete the
351 respective buffer. The buffer(s) will contain user and host
352 names. Passwords will never be included there.")
354 (when (>= tramp-verbose
6)
356 (let ((start (point)))
358 Please note that you have set `tramp-verbose' to a value of at
359 least 6. Therefore, the contents of files might be included in
360 the debug buffer(s).")
361 (add-text-properties start
(point) '(face italic
))))
363 (set-buffer-modified-p nil
)
364 (setq buffer-read-only t
)
365 (goto-char (point-min))
367 (if (y-or-n-p "Do you want to append the buffer(s)? ")
368 ;; OK, let's send. First we delete the buffer list.
371 (switch-to-buffer curbuf
)
372 (goto-char (point-max))
373 (insert (propertize "\n" 'display
"\n\
374 This is a special notion of the `gnus/message' package. If you
375 use another mail agent (by copying the contents of this buffer)
376 please ensure that the buffers are attached to your email.\n\n"))
377 (dolist (buffer buffer-list
)
378 (mml-insert-empty-tag
379 'part
'type
"text/plain"
380 'encoding
"base64" 'disposition
"attachment" 'buffer buffer
381 'description buffer
))
382 (set-buffer-modified-p nil
))
384 ;; Don't send. Delete the message buffer.
386 (set-buffer-modified-p nil
)
388 (throw 'dont-send nil
))))))
390 (defalias 'tramp-submit-bug
'tramp-bug
)
392 (add-hook 'tramp-unload-hook
393 (lambda () (unload-feature 'tramp-cmds
'force
)))
395 (provide 'tramp-cmds
)
399 ;; * Clean up unused *tramp/foo* buffers after a while. (Pete Forman)
401 ;; * WIBNI there was an interactive command prompting for Tramp
402 ;; method, hostname, username and filename and translates the user
403 ;; input into the correct filename syntax (depending on the Emacs
404 ;; flavor) (Reiner Steib)
406 ;; * Let the user edit the connection properties interactively.
407 ;; Something like `gnus-server-edit-server' in Gnus' *Server* buffer.
409 ;;; tramp-cmds.el ends here