lisp/net/tramp-cmds.el

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