lisp/net/tramp-cmds.el

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