Line data Source code
1 : ;;; tramp-cmds.el --- Interactive commands for Tramp -*- lexical-binding:t -*-
2 :
3 : ;; Copyright (C) 2007-2017 Free Software Foundation, Inc.
4 :
5 : ;; Author: Michael Albinus <michael.albinus@gmx.de>
6 : ;; Keywords: comm, processes
7 : ;; Package: tramp
8 :
9 : ;; This file is part of GNU Emacs.
10 :
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.
15 :
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.
20 :
21 : ;; You should have received a copy of the GNU General Public License
22 : ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23 :
24 : ;;; Commentary:
25 :
26 : ;; This package provides all interactive commands which are related
27 : ;; to Tramp.
28 :
29 : ;;; Code:
30 :
31 : (require 'tramp)
32 :
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)
39 :
40 : ;;;###tramp-autoload
41 : (defun tramp-change-syntax (&optional syntax)
42 : "Change Tramp syntax.
43 : SYNTAX can be one of the symbols `default' (default),
44 : `simplified' (ange-ftp like) or `separate' (XEmacs like)."
45 : (interactive
46 0 : (let ((input (completing-read
47 0 : "Enter Tramp syntax: " (tramp-syntax-values) nil t
48 0 : (symbol-name tramp-syntax))))
49 0 : (unless (string-equal input "")
50 0 : (list (intern input)))))
51 12 : (when syntax
52 12 : (custom-set-variables `(tramp-syntax ',syntax))))
53 :
54 : (defun tramp-list-tramp-buffers ()
55 : "Return a list of all Tramp connection buffers."
56 11 : (append
57 11 : (all-completions
58 11 : "*tramp" (mapcar 'list (mapcar 'buffer-name (buffer-list))))
59 11 : (all-completions
60 11 : "*debug tramp" (mapcar 'list (mapcar 'buffer-name (buffer-list))))))
61 :
62 : (defun tramp-list-remote-buffers ()
63 : "Return a list of all buffers with remote default-directory."
64 11 : (delq
65 : nil
66 11 : (mapcar
67 : (lambda (x)
68 2016 : (with-current-buffer x (when (tramp-tramp-file-p default-directory) x)))
69 11 : (buffer-list))))
70 :
71 : ;;;###tramp-autoload
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."
78 : (interactive
79 : ;; When interactive, select the Tramp remote identification.
80 : ;; Return nil when there is no Tramp connection.
81 0 : (list
82 0 : (let ((connections
83 0 : (mapcar
84 : (lambda (x)
85 0 : (tramp-make-tramp-file-name
86 0 : (tramp-file-name-method x)
87 0 : (tramp-file-name-user x)
88 0 : (tramp-file-name-domain x)
89 0 : (tramp-file-name-host x)
90 0 : (tramp-file-name-port x)
91 0 : (tramp-file-name-localname x)))
92 0 : (tramp-list-connections)))
93 : name)
94 :
95 0 : (when connections
96 0 : (setq name
97 0 : (completing-read
98 0 : "Enter Tramp connection: " connections nil t
99 0 : (try-completion "" connections)))
100 0 : (and (tramp-tramp-file-p name) (tramp-dissect-file-name name))))
101 0 : nil nil))
102 :
103 50 : (if (not vec)
104 : ;; Nothing to do.
105 0 : (message "No Tramp connection found.")
106 :
107 : ;; Flush password cache.
108 50 : (unless keep-password (tramp-clear-passwd vec))
109 :
110 : ;; Cleanup `tramp-current-connection'. Otherwise, we would be
111 : ;; suppressed in the test suite. We use `keep-password' as
112 : ;; indicator; it is not worth to add a new argument.
113 50 : (when keep-password (setq tramp-current-connection nil))
114 :
115 : ;; Flush file cache.
116 50 : (tramp-flush-directory-property vec "")
117 :
118 : ;; Flush connection cache.
119 50 : (when (processp (tramp-get-connection-process vec))
120 43 : (tramp-flush-connection-property (tramp-get-connection-process vec))
121 50 : (delete-process (tramp-get-connection-process vec)))
122 50 : (tramp-flush-connection-property vec)
123 :
124 : ;; Remove buffers.
125 50 : (dolist
126 50 : (buf (list (get-buffer (tramp-buffer-name vec))
127 50 : (unless keep-debug
128 50 : (get-buffer (tramp-debug-buffer-name vec)))
129 50 : (tramp-get-connection-property vec "process-buffer" nil)))
130 150 : (when (bufferp buf) (kill-buffer buf)))))
131 :
132 : ;;;###tramp-autoload
133 : (defun tramp-cleanup-this-connection ()
134 : "Flush all connection related objects of the current buffer's connection."
135 : (interactive)
136 0 : (and (tramp-tramp-file-p default-directory)
137 0 : (tramp-cleanup-connection
138 0 : (tramp-dissect-file-name default-directory 'noexpand))))
139 :
140 : ;;;###tramp-autoload
141 : (defun tramp-cleanup-all-connections ()
142 : "Flush all Tramp internal objects.
143 : This includes password cache, file cache, connection cache, buffers."
144 : (interactive)
145 :
146 : ;; Unlock Tramp.
147 11 : (setq tramp-locked nil)
148 :
149 : ;; Flush password cache.
150 11 : (password-reset)
151 :
152 : ;; Flush file and connection cache.
153 11 : (clrhash tramp-cache-data)
154 :
155 : ;; Remove buffers.
156 11 : (dolist (name (tramp-list-tramp-buffers))
157 11 : (when (bufferp (get-buffer name)) (kill-buffer name))))
158 :
159 : ;;;###tramp-autoload
160 : (defun tramp-cleanup-all-buffers ()
161 : "Kill all remote buffers."
162 : (interactive)
163 :
164 : ;; Remove all Tramp related connections.
165 11 : (tramp-cleanup-all-connections)
166 :
167 : ;; Remove all buffers with a remote default-directory.
168 11 : (dolist (name (tramp-list-remote-buffers))
169 11 : (when (bufferp (get-buffer name)) (kill-buffer name))))
170 :
171 : ;; Tramp version is useful in a number of situations.
172 :
173 : ;;;###tramp-autoload
174 : (defun tramp-version (arg)
175 : "Print version number of tramp.el in minibuffer or current buffer."
176 : (interactive "P")
177 0 : (if arg (insert tramp-version) (message tramp-version)))
178 :
179 : ;; Make the "reporter" functionality available for making bug reports about
180 : ;; the package. A most useful piece of code.
181 :
182 : (autoload 'reporter-submit-bug-report "reporter")
183 :
184 : ;;;###tramp-autoload
185 : (defun tramp-bug ()
186 : "Submit a bug report to the Tramp developers."
187 : (interactive)
188 0 : (catch 'dont-send
189 0 : (let ((reporter-prompt-for-summary-p t))
190 0 : (reporter-submit-bug-report
191 0 : tramp-bug-report-address ; to-address
192 0 : (format "tramp (%s)" tramp-version) ; package name and version
193 0 : (sort
194 0 : (delq nil (mapcar
195 : (lambda (x)
196 0 : (and x (boundp x) (cons x 'tramp-reporter-dump-variable)))
197 0 : (append
198 0 : (mapcar 'intern (all-completions "tramp-" obarray 'boundp))
199 : ;; Non-tramp variables of interest.
200 : '(shell-prompt-pattern
201 : backup-by-copying
202 : backup-by-copying-when-linked
203 : backup-by-copying-when-mismatch
204 : backup-by-copying-when-privileged-mismatch
205 : backup-directory-alist
206 : password-cache
207 : password-cache-expiry
208 : remote-file-name-inhibit-cache
209 : connection-local-profile-alist
210 : connection-local-criteria-alist
211 0 : file-name-handler-alist))))
212 0 : (lambda (x y) (string< (symbol-name (car x)) (symbol-name (car y)))))
213 :
214 : 'tramp-load-report-modules ; pre-hook
215 : 'tramp-append-tramp-buffers ; post-hook
216 0 : (propertize
217 : "\n" 'display "\
218 : Enter your bug report in this message, including as much detail
219 : as you possibly can about the problem, what you did to cause it
220 : and what the local and remote machines are.
221 :
222 : If you can give a simple set of instructions to make this bug
223 : happen reliably, please include those. Thank you for helping
224 : kill bugs in Tramp.
225 :
226 : Before reproducing the bug, you might apply
227 :
228 : M-x tramp-cleanup-all-connections
229 :
230 : This allows us to investigate from a clean environment. Another
231 : useful thing to do is to put
232 :
233 : (setq tramp-verbose 9)
234 :
235 : in your init file and to repeat the bug. Then, include the
236 : contents of the *tramp/foo* buffer and the *debug tramp/foo*
237 : buffer in your bug report.
238 :
239 : --bug report follows this line--
240 0 : ")))))
241 :
242 : (defun tramp-reporter-dump-variable (varsym mailbuf)
243 : "Pretty-print the value of the variable in symbol VARSYM."
244 0 : (let* ((reporter-eval-buffer (symbol-value 'reporter-eval-buffer))
245 0 : (val (with-current-buffer reporter-eval-buffer
246 0 : (symbol-value varsym))))
247 :
248 0 : (if (hash-table-p val)
249 : ;; Pretty print the cache.
250 0 : (set varsym (read (format "(%s)" (tramp-cache-print val))))
251 : ;; There are non-7bit characters to be masked.
252 0 : (when (and (stringp val)
253 0 : (string-match
254 0 : (concat "[^" (bound-and-true-p mm-7bit-chars) "]") val))
255 0 : (with-current-buffer reporter-eval-buffer
256 0 : (set
257 0 : varsym
258 0 : (format
259 : "(decode-coding-string (base64-decode-string \"%s\") 'raw-text)"
260 0 : (base64-encode-string (encode-coding-string val 'raw-text)))))))
261 :
262 : ;; Dump variable.
263 0 : (reporter-dump-variable varsym mailbuf)
264 :
265 0 : (unless (hash-table-p val)
266 : ;; Remove string quotation.
267 0 : (forward-line -1)
268 0 : (when (looking-at
269 0 : (concat "\\(^.*\\)" "\"" ;; \1 "
270 : "\\((base64-decode-string \\)" "\\\\" ;; \2 \
271 : "\\(\".*\\)" "\\\\" ;; \3 \
272 0 : "\\(\")\\)" "\"$")) ;; \4 "
273 0 : (replace-match "\\1\\2\\3\\4")
274 0 : (beginning-of-line)
275 0 : (insert " ;; Variable encoded due to non-printable characters.\n"))
276 0 : (forward-line 1))
277 :
278 : ;; Reset VARSYM to old value.
279 0 : (with-current-buffer reporter-eval-buffer
280 0 : (set varsym val))))
281 :
282 : (defun tramp-load-report-modules ()
283 : "Load needed modules for reporting."
284 0 : (message-mode)
285 0 : (mml-mode t))
286 :
287 : (defun tramp-append-tramp-buffers ()
288 : "Append Tramp buffers and buffer local variables into the bug report."
289 0 : (goto-char (point-max))
290 :
291 : ;; Dump buffer local variables.
292 0 : (insert "\nlocal variables:\n================")
293 0 : (dolist (buffer
294 0 : (delq nil
295 0 : (mapcar
296 : (lambda (b)
297 0 : (when (string-match "\\*tramp/" (buffer-name b)) b))
298 0 : (buffer-list))))
299 0 : (let ((reporter-eval-buffer buffer)
300 0 : (elbuf (get-buffer-create " *tmp-reporter-buffer*")))
301 0 : (with-current-buffer elbuf
302 0 : (emacs-lisp-mode)
303 0 : (erase-buffer)
304 0 : (insert (format "\n;; %s\n(setq-local\n" (buffer-name buffer)))
305 0 : (lisp-indent-line)
306 0 : (dolist
307 : (varsym
308 0 : (sort
309 0 : (append
310 0 : (mapcar
311 : 'intern
312 0 : (all-completions "tramp-" (buffer-local-variables buffer)))
313 : ;; Non-tramp variables of interest.
314 0 : '(connection-local-variables-alist default-directory))
315 0 : 'string<))
316 0 : (reporter-dump-variable varsym elbuf))
317 0 : (lisp-indent-line)
318 0 : (insert ")\n"))
319 0 : (insert-buffer-substring elbuf)))
320 :
321 : ;; Dump load-path shadows.
322 0 : (insert "\nload-path shadows:\n==================\n")
323 0 : (ignore-errors
324 0 : (mapc
325 0 : (lambda (x) (when (string-match "tramp" x) (insert x "\n")))
326 0 : (split-string (list-load-path-shadows t) "\n")))
327 :
328 : ;; Append buffers only when we are in message mode.
329 0 : (when (and
330 0 : (eq major-mode 'message-mode)
331 0 : (bound-and-true-p mml-mode))
332 :
333 0 : (let ((tramp-buf-regexp "\\*\\(debug \\)?tramp/")
334 0 : (buffer-list (tramp-list-tramp-buffers))
335 0 : (curbuf (current-buffer)))
336 :
337 : ;; There is at least one Tramp buffer.
338 0 : (when buffer-list
339 0 : (switch-to-buffer (list-buffers-noselect nil))
340 0 : (delete-other-windows)
341 0 : (setq buffer-read-only nil)
342 0 : (goto-char (point-min))
343 0 : (while (not (eobp))
344 0 : (if (re-search-forward tramp-buf-regexp (point-at-eol) t)
345 0 : (forward-line 1)
346 0 : (forward-line 0)
347 0 : (let ((start (point)))
348 0 : (forward-line 1)
349 0 : (kill-region start (point)))))
350 0 : (insert "
351 : The buffer(s) above will be appended to this message. If you
352 : don't want to append a buffer because it contains sensitive data,
353 : or because the buffer is too large, you should delete the
354 : respective buffer. The buffer(s) will contain user and host
355 0 : names. Passwords will never be included there.")
356 :
357 0 : (when (>= tramp-verbose 6)
358 0 : (insert "\n\n")
359 0 : (let ((start (point)))
360 0 : (insert "\
361 : Please note that you have set `tramp-verbose' to a value of at
362 : least 6. Therefore, the contents of files might be included in
363 0 : the debug buffer(s).")
364 0 : (add-text-properties start (point) '(face italic))))
365 :
366 0 : (set-buffer-modified-p nil)
367 0 : (setq buffer-read-only t)
368 0 : (goto-char (point-min))
369 :
370 0 : (if (y-or-n-p "Do you want to append the buffer(s)? ")
371 : ;; OK, let's send. First we delete the buffer list.
372 0 : (progn
373 0 : (kill-buffer nil)
374 0 : (switch-to-buffer curbuf)
375 0 : (goto-char (point-max))
376 0 : (insert (propertize "\n" 'display "\n\
377 : This is a special notion of the `gnus/message' package. If you
378 : use another mail agent (by copying the contents of this buffer)
379 0 : please ensure that the buffers are attached to your email.\n\n"))
380 0 : (dolist (buffer buffer-list)
381 0 : (mml-insert-empty-tag
382 : 'part 'type "text/plain"
383 0 : 'encoding "base64" 'disposition "attachment" 'buffer buffer
384 0 : 'description buffer))
385 0 : (set-buffer-modified-p nil))
386 :
387 : ;; Don't send. Delete the message buffer.
388 0 : (set-buffer curbuf)
389 0 : (set-buffer-modified-p nil)
390 0 : (kill-buffer nil)
391 0 : (throw 'dont-send nil))))))
392 :
393 : (defalias 'tramp-submit-bug 'tramp-bug)
394 :
395 : (add-hook 'tramp-unload-hook
396 : (lambda () (unload-feature 'tramp-cmds 'force)))
397 :
398 : (provide 'tramp-cmds)
399 :
400 : ;;; TODO:
401 :
402 : ;; * Clean up unused *tramp/foo* buffers after a while. (Pete Forman)
403 : ;;
404 : ;; * WIBNI there was an interactive command prompting for Tramp
405 : ;; method, hostname, username and filename and translates the user
406 : ;; input into the correct filename syntax (depending on the Emacs
407 : ;; flavor) (Reiner Steib)
408 : ;;
409 : ;; * Let the user edit the connection properties interactively.
410 : ;; Something like `gnus-server-edit-server' in Gnus' *Server* buffer.
411 :
412 : ;;; tramp-cmds.el ends here
|