tramp-cmds.el 12.8 KB
Newer Older
1 2
;;; tramp-cmds.el --- Interactive commands for Tramp

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
4 5 6

;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
7
;; Package: tramp
8 9 10

;; 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 14
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
15 16 17 18 19 20 21

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; 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 25

;;; Commentary:

Paul Eggert's avatar
Paul Eggert committed
26
;; This package provides all interactive commands which are related
27 28 29 30 31 32
;; to Tramp.

;;; Code:

(require 'tramp)

Michael Albinus's avatar
Michael Albinus committed
33
;; Pacify byte-compiler.
Michael Albinus's avatar
Michael Albinus committed
34 35
(defvar reporter-eval-buffer)
(defvar reporter-prompt-for-summary-p)
Michael Albinus's avatar
Michael Albinus committed
36

37 38 39 40 41 42 43 44 45 46 47 48 49 50
(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))))))

(defun tramp-list-remote-buffers ()
  "Return a list of all buffers with remote default-directory."
  (delq
   nil
   (mapcar
    (lambda (x)
Michael Albinus's avatar
Michael Albinus committed
51
      (with-current-buffer x (when (tramp-tramp-file-p default-directory) x)))
52 53
    (buffer-list))))

54
;;;###tramp-autoload
55
(defun tramp-cleanup-connection (vec &optional keep-debug keep-password)
56
  "Flush all connection related objects.
57 58 59
This includes password cache, file cache, connection cache,
buffers.  KEEP-DEBUG non-nil preserves the debug buffer.
KEEP-PASSWORD non-nil preserves the password cache.
60 61 62 63 64 65 66 67
When called interactively, a Tramp connection has to be selected."
  (interactive
   ;; When interactive, select the Tramp remote identification.
   ;; Return nil when there is no Tramp connection.
   (list
    (let ((connections
	   (mapcar
	    (lambda (x)
68 69 70 71 72
	      (tramp-make-tramp-file-name
	       (tramp-file-name-method x)
	       (tramp-file-name-user x)
	       (tramp-file-name-host x)
	       (tramp-file-name-localname x)))
73
	    (tramp-list-connections)))
74 75 76 77 78 79 80
	  name)

      (when connections
	(setq name
	      (completing-read
	       "Enter Tramp connection: " connections nil t
	       (try-completion "" connections)))
Michael Albinus's avatar
Michael Albinus committed
81
	(and (tramp-tramp-file-p name) (tramp-dissect-file-name name))))
82
    nil nil))
83 84 85 86 87 88

  (if (not vec)
      ;; Nothing to do.
      (message "No Tramp connection found.")

    ;; Flush password cache.
89
    (unless keep-password (tramp-clear-passwd vec))
90

91 92 93 94 95
    ;; Cleanup `tramp-current-connection'.  Otherwise, we would be
    ;; suppressed in the test suite.  We use `keep-password' as
    ;; indicator; it is not worth to add a new argument.
    (when keep-password (setq tramp-current-connection nil))

96
    ;; Flush file cache.
97
    (tramp-flush-directory-property vec "")
98 99

    ;; Flush connection cache.
Michael Albinus's avatar
Michael Albinus committed
100 101 102
    (when (processp (tramp-get-connection-process vec))
      (delete-process (tramp-get-connection-process vec))
      (tramp-flush-connection-property (tramp-get-connection-process vec)))
103
    (tramp-flush-connection-property vec)
104 105 106 107

    ;; Remove buffers.
    (dolist
	(buf (list (get-buffer (tramp-buffer-name vec))
108 109
		   (unless keep-debug
		     (get-buffer (tramp-debug-buffer-name vec)))
110 111 112
		   (tramp-get-connection-property vec "process-buffer" nil)))
      (when (bufferp buf) (kill-buffer buf)))))

113 114 115 116
;;;###tramp-autoload
(defun tramp-cleanup-this-connection ()
  "Flush all connection related objects of the current buffer's connection."
  (interactive)
Michael Albinus's avatar
Michael Albinus committed
117
  (and (tramp-tramp-file-p default-directory)
118 119 120
       (tramp-cleanup-connection
	(tramp-dissect-file-name default-directory 'noexpand))))

121
;;;###tramp-autoload
122 123 124 125 126
(defun tramp-cleanup-all-connections ()
  "Flush all Tramp internal objects.
This includes password cache, file cache, connection cache, buffers."
  (interactive)

127 128 129
  ;; Unlock Tramp.
  (setq tramp-locked nil)

130
  ;; Flush password cache.
131
  (tramp-compat-funcall 'password-reset)
132 133 134 135 136 137 138 139

  ;; Flush file and connection cache.
  (clrhash tramp-cache-data)

  ;; Remove buffers.
  (dolist (name (tramp-list-tramp-buffers))
    (when (bufferp (get-buffer name)) (kill-buffer name))))

140
;;;###tramp-autoload
141 142 143 144 145 146 147 148 149 150 151
(defun tramp-cleanup-all-buffers ()
  "Kill all remote buffers."
  (interactive)

  ;; Remove all Tramp related buffers.
  (tramp-cleanup-all-connections)

  ;; Remove all buffers with a remote default-directory.
  (dolist (name (tramp-list-remote-buffers))
    (when (bufferp (get-buffer name)) (kill-buffer name))))

152 153
;; Tramp version is useful in a number of situations.

154
;;;###tramp-autoload
155 156 157 158 159
(defun tramp-version (arg)
  "Print version number of tramp.el in minibuffer or current buffer."
  (interactive "P")
  (if arg (insert tramp-version) (message tramp-version)))

160
;; Make the "reporter" functionality available for making bug reports about
161
;; the package.  A most useful piece of code.
162 163 164

(autoload 'reporter-submit-bug-report "reporter")

165
;;;###tramp-autoload
166 167 168 169 170 171 172 173 174
(defun tramp-bug ()
  "Submit a bug report to the Tramp developers."
  (interactive)
  (require 'reporter)
  (catch 'dont-send
    (let ((reporter-prompt-for-summary-p t))
      (reporter-submit-bug-report
       tramp-bug-report-address		; to-address
       (format "tramp (%s)" tramp-version) ; package name and version
175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193
       (sort
	(delq nil (mapcar
	  (lambda (x)
	    (and x (boundp x) (cons x 'tramp-reporter-dump-variable)))
	  (append
	   (mapcar 'intern (all-completions "tramp-" obarray 'boundp))
	   ;; Non-tramp variables of interest.
	   '(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
	     bkup-backup-directory-info
	     password-cache
	     password-cache-expiry
	     remote-file-name-inhibit-cache
	     file-name-handler-alist))))
	(lambda (x y) (string< (symbol-name (car x)) (symbol-name (car y)))))
194 195 196

       'tramp-load-report-modules	; pre-hook
       'tramp-append-tramp-buffers	; post-hook
Michael Albinus's avatar
Michael Albinus committed
197
       (tramp-compat-funcall
198 199
	(if (functionp 'propertize) 'propertize 'progn)
	"\n" 'display "\
200 201 202 203 204 205 206 207
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.

208 209 210 211 212 213
Before reproducing the bug, you might apply

  M-x tramp-cleanup-all-connections

This allows to investigate from a clean environment.  Another
useful thing to do is to put
214

215
  (setq tramp-verbose 9)
216

217
in your init file and to repeat the bug.  Then, include the
218 219 220 221
contents of the *tramp/foo* buffer and the *debug tramp/foo*
buffer in your bug report.

--bug report follows this line--
222
")))))
223 224

(defun tramp-reporter-dump-variable (varsym mailbuf)
225
  "Pretty-print the value of the variable in symbol VARSYM."
226 227 228 229 230 231 232
  (let* ((reporter-eval-buffer (symbol-value 'reporter-eval-buffer))
	 (val (with-current-buffer reporter-eval-buffer
		(symbol-value varsym))))

    (if (hash-table-p val)
	;; Pretty print the cache.
	(set varsym (read (format "(%s)" (tramp-cache-print val))))
233
      ;; There are non-7bit characters to be masked.
234
      (when (and (boundp 'mm-7bit-chars)
235
		 (stringp val)
236 237 238
		 (string-match
		  (concat "[^" (symbol-value 'mm-7bit-chars) "]") val))
	(with-current-buffer reporter-eval-buffer
239 240 241 242 243
	  (set
	   varsym
	   (format
	    "(decode-coding-string (base64-decode-string \"%s\") 'raw-text)"
	    (base64-encode-string (encode-coding-string val 'raw-text)))))))
244 245

    ;; Dump variable.
246
    (tramp-compat-funcall 'reporter-dump-variable varsym mailbuf)
247 248 249 250 251 252 253 254 255 256 257

    (unless (hash-table-p val)
      ;; Remove string quotation.
      (forward-line -1)
      (when (looking-at
	     (concat "\\(^.*\\)" "\""                       ;; \1 "
		     "\\((base64-decode-string \\)" "\\\\"  ;; \2 \
		     "\\(\".*\\)" "\\\\"                    ;; \3 \
		     "\\(\")\\)" "\"$"))                    ;; \4 "
	(replace-match "\\1\\2\\3\\4")
	(beginning-of-line)
258
	(insert " ;; Variable encoded due to non-printable characters.\n"))
259 260 261 262 263 264 265 266 267 268 269 270 271 272 273
      (forward-line 1))

    ;; Reset VARSYM to old value.
    (with-current-buffer reporter-eval-buffer
      (set varsym val))))

(defun tramp-load-report-modules ()
  "Load needed modules for reporting."
  ;; We load message.el and mml.el from Gnus.
  (if (featurep 'xemacs)
      (progn
	(load "message" 'noerror)
	(load "mml" 'noerror))
    (require 'message nil 'noerror)
    (require 'mml nil 'noerror))
274 275
  (tramp-compat-funcall 'message-mode)
  (tramp-compat-funcall 'mml-mode t))
276 277 278 279 280 281

(defun tramp-append-tramp-buffers ()
  "Append Tramp buffers and buffer local variables into the bug report."
  (goto-char (point-max))

  ;; Dump buffer local variables.
282
  (insert "\nlocal variables:\n================")
283 284 285
  (dolist (buffer
	   (delq nil
		 (mapcar
286 287
		  (lambda (b)
                    (when (string-match "\\*tramp/" (buffer-name b)) b))
288 289 290 291 292 293
		  (buffer-list))))
    (let ((reporter-eval-buffer buffer)
	  (elbuf (get-buffer-create " *tmp-reporter-buffer*")))
      (with-current-buffer elbuf
	(emacs-lisp-mode)
	(erase-buffer)
294
	(insert (format "\n;; %s\n(setq-local\n" (buffer-name buffer)))
295
	(lisp-indent-line)
296 297 298 299 300 301 302 303 304 305 306
	(dolist
	    (varsym
	     (sort
	      (append
	       (mapcar
		'intern
		(all-completions "tramp-" (buffer-local-variables buffer)))
	       ;; Non-tramp variables of interest.
	       '(default-directory))
	      'string<))
	    (tramp-compat-funcall 'reporter-dump-variable varsym elbuf))
307 308 309 310
	(lisp-indent-line)
	(insert ")\n"))
      (insert-buffer-substring elbuf)))

311 312 313
  ;; Dump load-path shadows.
  (insert "\nload-path shadows:\n==================\n")
  (ignore-errors
Michael Albinus's avatar
Michael Albinus committed
314 315 316
    (mapc
     (lambda (x) (when (string-match "tramp" x) (insert x "\n")))
     (split-string (tramp-compat-funcall 'list-load-path-shadows t) "\n")))
317

318 319 320 321 322 323 324
  ;; Append buffers only when we are in message mode.
  (when (and
	 (eq major-mode 'message-mode)
	 (boundp 'mml-mode)
	 (symbol-value 'mml-mode))

    (let ((tramp-buf-regexp "\\*\\(debug \\)?tramp/")
325
	  (buffer-list (tramp-compat-funcall 'tramp-list-tramp-buffers))
326 327 328 329
	  (curbuf (current-buffer)))

      ;; There is at least one Tramp buffer.
      (when buffer-list
330
	(switch-to-buffer (list-buffers-noselect nil))
331 332 333 334
	(delete-other-windows)
	(setq buffer-read-only nil)
	(goto-char (point-min))
	(while (not (eobp))
335
	  (if (re-search-forward tramp-buf-regexp (point-at-eol) t)
336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364
	      (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) (list 'face 'italic))))

	(set-buffer-modified-p nil)
	(setq buffer-read-only t)
	(goto-char (point-min))

	(if (y-or-n-p "Do you want to append the buffer(s)? ")
	    ;; OK, let's send.  First we delete the buffer list.
	    (progn
	      (kill-buffer nil)
365
	      (switch-to-buffer curbuf)
366
	      (goto-char (point-max))
Michael Albinus's avatar
Michael Albinus committed
367
	      (insert (tramp-compat-funcall 'propertize "\n" 'display "\n\
368 369
This is a special notion of the `gnus/message' package.  If you
use another mail agent (by copying the contents of this buffer)
370
please ensure that the buffers are attached to your email.\n\n"))
371
	      (dolist (buffer buffer-list)
372 373 374 375
		(tramp-compat-funcall
		 'mml-insert-empty-tag 'part 'type "text/plain"
		 'encoding "base64" 'disposition "attachment" 'buffer buffer
		 'description buffer))
376 377 378 379 380 381 382 383 384 385
	      (set-buffer-modified-p nil))

	  ;; Don't send.  Delete the message buffer.
	  (set-buffer curbuf)
	  (set-buffer-modified-p nil)
	  (kill-buffer nil)
	  (throw 'dont-send nil))))))

(defalias 'tramp-submit-bug 'tramp-bug)

386 387 388
(add-hook 'tramp-unload-hook
	  (lambda () (unload-feature 'tramp-cmds 'force)))

389 390 391 392 393
(provide 'tramp-cmds)

;;; TODO:

;; * Clean up unused *tramp/foo* buffers after a while.  (Pete Forman)
394
;; * WIBNI there was an interactive command prompting for Tramp
395 396
;;   method, hostname, username and filename and translates the user
;;   input into the correct filename syntax (depending on the Emacs
397
;;   flavor)  (Reiner Steib)
398 399 400 401
;; * Let the user edit the connection properties interactively.
;;   Something like `gnus-server-edit-server' in Gnus' *Server* buffer.

;;; tramp-cmds.el ends here