lisp/net/tramp-cmds.el

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