code.delx.au - gnu-emacs/blob - lisp/net/tramp-cmds.el

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