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