lisp/net/tramp-cmds.el

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