lisp/net/tramp-cmds.el

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