Commit | Line | Data |
---|---|---|
9c13938d MA |
1 | ;;; tramp-cmds.el --- Interactive commands for Tramp |
2 | ||
dcb8ac09 | 3 | ;; Copyright (C) 2007, 2008 Free Software Foundation, Inc. |
9c13938d MA |
4 | |
5 | ;; Author: Michael Albinus <michael.albinus@gmx.de> | |
6 | ;; Keywords: comm, processes | |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
874a927a | 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
9c13938d | 11 | ;; it under the terms of the GNU General Public License as published by |
874a927a GM |
12 | ;; the Free Software Foundation, either version 3 of the License, or |
13 | ;; (at your option) any later version. | |
9c13938d MA |
14 | |
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
874a927a | 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
9c13938d MA |
22 | |
23 | ;;; Commentary: | |
24 | ||
25 | ;; This package provides all interactive commands which are releated | |
26 | ;; to Tramp. | |
27 | ||
28 | ;;; Code: | |
29 | ||
30 | (require 'tramp) | |
31 | ||
32 | (defun tramp-list-tramp-buffers () | |
33 | "Return a list of all Tramp connection buffers." | |
34 | (append | |
35 | (all-completions | |
36 | "*tramp" (mapcar 'list (mapcar 'buffer-name (buffer-list)))) | |
37 | (all-completions | |
38 | "*debug tramp" (mapcar 'list (mapcar 'buffer-name (buffer-list)))))) | |
39 | ||
40 | (defun tramp-list-remote-buffers () | |
41 | "Return a list of all buffers with remote default-directory." | |
42 | (delq | |
43 | nil | |
44 | (mapcar | |
45 | (lambda (x) | |
46 | (with-current-buffer x | |
47 | (when (and (stringp default-directory) | |
48 | (file-remote-p default-directory)) | |
49 | x))) | |
50 | (buffer-list)))) | |
51 | ||
52 | (defun tramp-cleanup-connection (vec) | |
53 | "Flush all connection related objects. | |
54 | This includes password cache, file cache, connection cache, buffers. | |
55 | When called interactively, a Tramp connection has to be selected." | |
56 | (interactive | |
57 | ;; When interactive, select the Tramp remote identification. | |
58 | ;; Return nil when there is no Tramp connection. | |
59 | (list | |
60 | (let ((connections | |
61 | (mapcar | |
62 | (lambda (x) | |
726f0272 MA |
63 | (tramp-make-tramp-file-name |
64 | (tramp-file-name-method x) | |
65 | (tramp-file-name-user x) | |
66 | (tramp-file-name-host x) | |
67 | (tramp-file-name-localname x))) | |
b08104a0 | 68 | (tramp-list-connections))) |
9c13938d MA |
69 | name) |
70 | ||
71 | (when connections | |
72 | (setq name | |
73 | (completing-read | |
74 | "Enter Tramp connection: " connections nil t | |
75 | (try-completion "" connections))) | |
76 | (when (and name (file-remote-p name)) | |
77 | (with-parsed-tramp-file-name name nil v)))))) | |
78 | ||
79 | (if (not vec) | |
80 | ;; Nothing to do. | |
81 | (message "No Tramp connection found.") | |
82 | ||
83 | ;; Flush password cache. | |
84 | (tramp-clear-passwd vec) | |
85 | ||
86 | ;; Flush file cache. | |
87 | (tramp-flush-directory-property vec "/") | |
88 | ||
89 | ;; Flush connection cache. | |
9d7cb26e GM |
90 | (tramp-flush-connection-property (tramp-get-connection-process vec)) |
91 | (tramp-flush-connection-property vec) | |
9c13938d MA |
92 | |
93 | ;; Remove buffers. | |
94 | (dolist | |
95 | (buf (list (get-buffer (tramp-buffer-name vec)) | |
96 | (get-buffer (tramp-debug-buffer-name vec)) | |
97 | (tramp-get-connection-property vec "process-buffer" nil))) | |
98 | (when (bufferp buf) (kill-buffer buf))))) | |
99 | ||
100 | (defun tramp-cleanup-all-connections () | |
101 | "Flush all Tramp internal objects. | |
102 | This includes password cache, file cache, connection cache, buffers." | |
103 | (interactive) | |
104 | ||
105 | ;; Flush password cache. | |
106 | (when (functionp 'password-reset) | |
107 | (funcall (symbol-function 'password-reset))) | |
108 | ||
109 | ;; Flush file and connection cache. | |
110 | (clrhash tramp-cache-data) | |
111 | ||
112 | ;; Remove buffers. | |
113 | (dolist (name (tramp-list-tramp-buffers)) | |
114 | (when (bufferp (get-buffer name)) (kill-buffer name)))) | |
115 | ||
116 | (defun tramp-cleanup-all-buffers () | |
117 | "Kill all remote buffers." | |
118 | (interactive) | |
119 | ||
120 | ;; Remove all Tramp related buffers. | |
121 | (tramp-cleanup-all-connections) | |
122 | ||
123 | ;; Remove all buffers with a remote default-directory. | |
124 | (dolist (name (tramp-list-remote-buffers)) | |
125 | (when (bufferp (get-buffer name)) (kill-buffer name)))) | |
126 | ||
a4aeb9a4 MA |
127 | ;; Tramp version is useful in a number of situations. |
128 | ||
129 | (defun tramp-version (arg) | |
130 | "Print version number of tramp.el in minibuffer or current buffer." | |
131 | (interactive "P") | |
132 | (if arg (insert tramp-version) (message tramp-version))) | |
133 | ||
134 | ;; Make the `reporter` functionality available for making bug reports about | |
135 | ;; the package. A most useful piece of code. | |
136 | ||
137 | (autoload 'reporter-submit-bug-report "reporter") | |
138 | ||
139 | (defun tramp-bug () | |
140 | "Submit a bug report to the Tramp developers." | |
141 | (interactive) | |
142 | (require 'reporter) | |
143 | (catch 'dont-send | |
144 | (let ((reporter-prompt-for-summary-p t)) | |
145 | (reporter-submit-bug-report | |
146 | tramp-bug-report-address ; to-address | |
147 | (format "tramp (%s)" tramp-version) ; package name and version | |
148 | (delq nil | |
149 | `(;; Current state | |
150 | tramp-current-method | |
151 | tramp-current-user | |
152 | tramp-current-host | |
153 | ||
154 | ;; System defaults | |
155 | tramp-auto-save-directory ; vars to dump | |
156 | tramp-default-method | |
157 | tramp-default-method-alist | |
158 | tramp-default-host | |
159 | tramp-default-proxies-alist | |
160 | tramp-default-user | |
161 | tramp-default-user-alist | |
162 | tramp-rsh-end-of-line | |
163 | tramp-default-password-end-of-line | |
164 | tramp-login-prompt-regexp | |
165 | ;; Mask non-7bit characters | |
166 | (tramp-password-prompt-regexp . tramp-reporter-dump-variable) | |
167 | tramp-wrong-passwd-regexp | |
168 | tramp-yesno-prompt-regexp | |
169 | tramp-yn-prompt-regexp | |
170 | tramp-terminal-prompt-regexp | |
171 | tramp-temp-name-prefix | |
172 | tramp-file-name-structure | |
173 | tramp-file-name-regexp | |
174 | tramp-methods | |
175 | tramp-end-of-output | |
176 | tramp-local-coding-commands | |
177 | tramp-remote-coding-commands | |
178 | tramp-actions-before-shell | |
179 | tramp-actions-copy-out-of-band | |
180 | tramp-terminal-type | |
181 | ;; Mask non-7bit characters | |
182 | (tramp-shell-prompt-pattern . tramp-reporter-dump-variable) | |
183 | ,(when (boundp 'tramp-backup-directory-alist) | |
184 | 'tramp-backup-directory-alist) | |
185 | ,(when (boundp 'tramp-bkup-backup-directory-info) | |
186 | 'tramp-bkup-backup-directory-info) | |
187 | ;; Dump cache. | |
188 | (tramp-cache-data . tramp-reporter-dump-variable) | |
189 | ||
190 | ;; Non-tramp variables of interest | |
191 | ;; Mask non-7bit characters | |
192 | (shell-prompt-pattern . tramp-reporter-dump-variable) | |
193 | backup-by-copying | |
194 | backup-by-copying-when-linked | |
195 | backup-by-copying-when-mismatch | |
196 | ,(when (boundp 'backup-by-copying-when-privileged-mismatch) | |
197 | 'backup-by-copying-when-privileged-mismatch) | |
198 | ,(when (boundp 'password-cache) | |
199 | 'password-cache) | |
200 | ,(when (boundp 'password-cache-expiry) | |
201 | 'password-cache-expiry) | |
202 | ,(when (boundp 'backup-directory-alist) | |
203 | 'backup-directory-alist) | |
204 | ,(when (boundp 'bkup-backup-directory-info) | |
205 | 'bkup-backup-directory-info) | |
206 | file-name-handler-alist)) | |
207 | ||
208 | 'tramp-load-report-modules ; pre-hook | |
209 | 'tramp-append-tramp-buffers ; post-hook | |
210 | "\ | |
211 | Enter your bug report in this message, including as much detail | |
212 | as you possibly can about the problem, what you did to cause it | |
213 | and what the local and remote machines are. | |
214 | ||
215 | If you can give a simple set of instructions to make this bug | |
216 | happen reliably, please include those. Thank you for helping | |
217 | kill bugs in Tramp. | |
218 | ||
219 | Another useful thing to do is to put | |
220 | ||
221 | (setq tramp-verbose 8) | |
222 | ||
223 | in the ~/.emacs file and to repeat the bug. Then, include the | |
224 | contents of the *tramp/foo* buffer and the *debug tramp/foo* | |
225 | buffer in your bug report. | |
226 | ||
227 | --bug report follows this line-- | |
228 | ")))) | |
229 | ||
230 | (defun tramp-reporter-dump-variable (varsym mailbuf) | |
231 | "Pretty-print the value of the variable in symbol VARSYM. | |
232 | Used for non-7bit chars in strings." | |
233 | (let* ((reporter-eval-buffer (symbol-value 'reporter-eval-buffer)) | |
234 | (val (with-current-buffer reporter-eval-buffer | |
235 | (symbol-value varsym)))) | |
236 | ||
237 | (if (hash-table-p val) | |
238 | ;; Pretty print the cache. | |
239 | (set varsym (read (format "(%s)" (tramp-cache-print val)))) | |
240 | ;; There are characters to be masked. | |
241 | (when (and (boundp 'mm-7bit-chars) | |
242 | (string-match | |
243 | (concat "[^" (symbol-value 'mm-7bit-chars) "]") val)) | |
244 | (with-current-buffer reporter-eval-buffer | |
245 | (set varsym (format "(base64-decode-string \"%s\"" | |
246 | (base64-encode-string val)))))) | |
247 | ||
248 | ;; Dump variable. | |
249 | (funcall (symbol-function 'reporter-dump-variable) varsym mailbuf) | |
250 | ||
251 | (unless (hash-table-p val) | |
252 | ;; Remove string quotation. | |
253 | (forward-line -1) | |
254 | (when (looking-at | |
255 | (concat "\\(^.*\\)" "\"" ;; \1 " | |
256 | "\\((base64-decode-string \\)" "\\\\" ;; \2 \ | |
257 | "\\(\".*\\)" "\\\\" ;; \3 \ | |
258 | "\\(\")\\)" "\"$")) ;; \4 " | |
259 | (replace-match "\\1\\2\\3\\4") | |
260 | (beginning-of-line) | |
261 | (insert " ;; variable encoded due to non-printable characters\n")) | |
262 | (forward-line 1)) | |
263 | ||
264 | ;; Reset VARSYM to old value. | |
265 | (with-current-buffer reporter-eval-buffer | |
266 | (set varsym val)))) | |
267 | ||
268 | (defun tramp-load-report-modules () | |
269 | "Load needed modules for reporting." | |
270 | ||
271 | ;; We load message.el and mml.el from Gnus. | |
272 | (if (featurep 'xemacs) | |
273 | (progn | |
274 | (load "message" 'noerror) | |
275 | (load "mml" 'noerror)) | |
276 | (require 'message nil 'noerror) | |
277 | (require 'mml nil 'noerror)) | |
278 | (when (functionp 'message-mode) | |
279 | (funcall (symbol-function 'message-mode))) | |
280 | (when (functionp 'mml-mode) | |
281 | (funcall (symbol-function 'mml-mode) t))) | |
282 | ||
283 | (defun tramp-append-tramp-buffers () | |
284 | "Append Tramp buffers and buffer local variables into the bug report." | |
285 | ||
286 | (goto-char (point-max)) | |
287 | ||
288 | ;; Dump buffer local variables. | |
289 | (dolist (buffer | |
290 | (delq nil | |
291 | (mapcar | |
292 | '(lambda (b) | |
293 | (when (string-match "\\*tramp/" (buffer-name b)) b)) | |
294 | (buffer-list)))) | |
295 | (let ((reporter-eval-buffer buffer) | |
296 | (buffer-name (buffer-name buffer)) | |
297 | (elbuf (get-buffer-create " *tmp-reporter-buffer*"))) | |
298 | (with-current-buffer elbuf | |
299 | (emacs-lisp-mode) | |
300 | (erase-buffer) | |
301 | (insert "\n(setq\n") | |
302 | (lisp-indent-line) | |
303 | (funcall (symbol-function 'reporter-dump-variable) | |
304 | 'buffer-name (current-buffer)) | |
305 | (dolist (varsym-or-cons-cell (buffer-local-variables buffer)) | |
306 | (let ((varsym (or (car-safe varsym-or-cons-cell) | |
307 | varsym-or-cons-cell))) | |
308 | (when (string-match "tramp" (symbol-name varsym)) | |
309 | (funcall | |
310 | (symbol-function 'reporter-dump-variable) | |
311 | varsym (current-buffer))))) | |
312 | (lisp-indent-line) | |
313 | (insert ")\n")) | |
314 | (insert-buffer-substring elbuf))) | |
315 | ||
316 | ;; Append buffers only when we are in message mode. | |
317 | (when (and | |
318 | (eq major-mode 'message-mode) | |
319 | (boundp 'mml-mode) | |
320 | (symbol-value 'mml-mode)) | |
321 | ||
322 | (let ((tramp-buf-regexp "\\*\\(debug \\)?tramp/") | |
323 | (buffer-list (funcall (symbol-function 'tramp-list-tramp-buffers))) | |
324 | (curbuf (current-buffer))) | |
325 | ||
326 | ;; There is at least one Tramp buffer. | |
327 | (when buffer-list | |
328 | (switch-to-buffer (list-buffers-noselect nil)) | |
329 | (delete-other-windows) | |
330 | (setq buffer-read-only nil) | |
331 | (goto-char (point-min)) | |
332 | (while (not (eobp)) | |
333 | (if (re-search-forward | |
334 | tramp-buf-regexp (tramp-compat-line-end-position) t) | |
335 | (forward-line 1) | |
336 | (forward-line 0) | |
337 | (let ((start (point))) | |
338 | (forward-line 1) | |
339 | (kill-region start (point))))) | |
340 | (insert " | |
341 | The buffer(s) above will be appended to this message. If you | |
342 | don't want to append a buffer because it contains sensitive data, | |
343 | or because the buffer is too large, you should delete the | |
344 | respective buffer. The buffer(s) will contain user and host | |
345 | names. Passwords will never be included there.") | |
346 | ||
347 | (when (>= tramp-verbose 6) | |
348 | (insert "\n\n") | |
349 | (let ((start (point))) | |
350 | (insert "\ | |
351 | Please note that you have set `tramp-verbose' to a value of at | |
352 | least 6. Therefore, the contents of files might be included in | |
353 | the debug buffer(s).") | |
354 | (add-text-properties start (point) (list 'face 'italic)))) | |
355 | ||
356 | (set-buffer-modified-p nil) | |
357 | (setq buffer-read-only t) | |
358 | (goto-char (point-min)) | |
359 | ||
360 | (if (y-or-n-p "Do you want to append the buffer(s)? ") | |
361 | ;; OK, let's send. First we delete the buffer list. | |
362 | (progn | |
363 | (kill-buffer nil) | |
364 | (switch-to-buffer curbuf) | |
365 | (goto-char (point-max)) | |
366 | (insert "\n\ | |
367 | This is a special notion of the `gnus/message' package. If you | |
368 | use another mail agent (by copying the contents of this buffer) | |
369 | please ensure that the buffers are attached to your email.\n\n") | |
370 | (dolist (buffer buffer-list) | |
371 | (funcall (symbol-function 'mml-insert-empty-tag) | |
372 | 'part 'type "text/plain" 'encoding "base64" | |
373 | 'disposition "attachment" 'buffer buffer | |
374 | 'description buffer)) | |
375 | (set-buffer-modified-p nil)) | |
376 | ||
377 | ;; Don't send. Delete the message buffer. | |
378 | (set-buffer curbuf) | |
379 | (set-buffer-modified-p nil) | |
380 | (kill-buffer nil) | |
381 | (throw 'dont-send nil)))))) | |
382 | ||
383 | (defalias 'tramp-submit-bug 'tramp-bug) | |
384 | ||
9c13938d MA |
385 | (provide 'tramp-cmds) |
386 | ||
387 | ;;; TODO: | |
388 | ||
389 | ;; * Clean up unused *tramp/foo* buffers after a while. (Pete Forman) | |
a4aeb9a4 | 390 | ;; * WIBNI there was an interactive command prompting for Tramp |
9c13938d MA |
391 | ;; method, hostname, username and filename and translates the user |
392 | ;; input into the correct filename syntax (depending on the Emacs | |
393 | ;; flavor) (Reiner Steib) | |
394 | ;; * Let the user edit the connection properties interactively. | |
395 | ;; Something like `gnus-server-edit-server' in Gnus' *Server* buffer. | |
396 | ;; * It's just that when I come to Customize `tramp-default-user-alist' | |
397 | ;; I'm presented with a mismatch and raw lisp for a value. It is my | |
398 | ;; understanding that a variable declared with defcustom is a User | |
399 | ;; Option and should not be modified by the code. add-to-list is | |
400 | ;; called in several places. One way to handle that is to have a new | |
401 | ;; ordinary variable that gets its initial value from | |
402 | ;; tramp-default-user-alist and then is added to. (Pete Forman) | |
403 | ||
ea161fff | 404 | ;; arch-tag: 190d4c33-76bb-4e99-8b6f-71741f23d98c |
9c13938d | 405 | ;;; tramp-cmds.el ends here |