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