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

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