cgit.sxemacs.org Git - packages/blob - xemacs-packages/tramp/lisp/tramp-cmds.el

   1 ;;; tramp-cmds.el --- Interactive commands for Tramp
   2
   3 ;; Copyright (C) 2007-2015 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 (when (tramp-tramp-file-p default-directory) x)))
  52     (buffer-list))))
  53
  54 ;;;###tramp-autoload
  55 (defun tramp-cleanup-connection (vec &optional keep-debug keep-password)
  56   "Flush all connection related objects.
  57 This includes password cache, file cache, connection cache,
  58 buffers.  KEEP-DEBUG non-nil preserves the debug buffer.
  59 KEEP-PASSWORD non-nil preserves the password cache.
  60 When called interactively, a Tramp connection has to be selected."
  61   (interactive
  62    ;; When interactive, select the Tramp remote identification.
  63    ;; Return nil when there is no Tramp connection.
  64    (list
  65     (let ((connections
  66            (mapcar
  67             (lambda (x)
  68               (tramp-make-tramp-file-name
  69                (tramp-file-name-method x)
  70                (tramp-file-name-user x)
  71                (tramp-file-name-host x)
  72                (tramp-file-name-localname x)))
  73             (tramp-list-connections)))
  74           name)
  75
  76       (when connections
  77         (setq name
  78               (completing-read
  79                "Enter Tramp connection: " connections nil t
  80                (try-completion "" connections)))
  81         (and (tramp-tramp-file-p name) (tramp-dissect-file-name name))))
  82     nil nil))
  83
  84   (if (not vec)
  85       ;; Nothing to do.
  86       (message "No Tramp connection found.")
  87
  88     ;; Flush password cache.
  89     (unless keep-password (tramp-clear-passwd vec))
  90
  91     ;; Cleanup `tramp-current-connection'.  Otherwise, we would be
  92     ;; suppressed in the test suite.  We use `keep-password' as
  93     ;; indicator; it is not worth to add a new argument.
  94     (when keep-password (setq tramp-current-connection nil))
  95
  96     ;; Flush file cache.
  97     (tramp-flush-directory-property vec "")
  98
  99     ;; Flush connection cache.
 100     (when (processp (tramp-get-connection-process vec))
 101       (delete-process (tramp-get-connection-process vec))
 102       (tramp-flush-connection-property (tramp-get-connection-process vec)))
 103     (tramp-flush-connection-property vec)
 104
 105     ;; Remove buffers.
 106     (dolist
 107         (buf (list (get-buffer (tramp-buffer-name vec))
 108                    (unless keep-debug
 109                      (get-buffer (tramp-debug-buffer-name vec)))
 110                    (tramp-get-connection-property vec "process-buffer" nil)))
 111       (when (bufferp buf) (kill-buffer buf)))))
 112
 113 ;;;###tramp-autoload
 114 (defun tramp-cleanup-this-connection ()
 115   "Flush all connection related objects of the current buffer's connection."
 116   (interactive)
 117   (and (tramp-tramp-file-p default-directory)
 118        (tramp-cleanup-connection
 119         (tramp-dissect-file-name default-directory 'noexpand))))
 120
 121 ;;;###tramp-autoload
 122 (defun tramp-cleanup-all-connections ()
 123   "Flush all Tramp internal objects.
 124 This includes password cache, file cache, connection cache, buffers."
 125   (interactive)
 126
 127   ;; Unlock Tramp.
 128   (setq tramp-locked nil)
 129
 130   ;; Flush password cache.
 131   (tramp-compat-funcall 'password-reset)
 132
 133   ;; Flush file and connection cache.
 134   (clrhash tramp-cache-data)
 135
 136   ;; Remove buffers.
 137   (dolist (name (tramp-list-tramp-buffers))
 138     (when (bufferp (get-buffer name)) (kill-buffer name))))
 139
 140 ;;;###tramp-autoload
 141 (defun tramp-cleanup-all-buffers ()
 142   "Kill all remote buffers."
 143   (interactive)
 144
 145   ;; Remove all Tramp related buffers.
 146   (tramp-cleanup-all-connections)
 147
 148   ;; Remove all buffers with a remote default-directory.
 149   (dolist (name (tramp-list-remote-buffers))
 150     (when (bufferp (get-buffer name)) (kill-buffer name))))
 151
 152 ;; Tramp version is useful in a number of situations.
 153
 154 ;;;###tramp-autoload
 155 (defun tramp-version (arg)
 156   "Print version number of tramp.el in minibuffer or current buffer."
 157   (interactive "P")
 158   (if arg (insert tramp-version) (message tramp-version)))
 159
 160 ;; Make the "reporter" functionality available for making bug reports about
 161 ;; the package.  A most useful piece of code.
 162
 163 (autoload 'reporter-submit-bug-report "reporter")
 164
 165 ;;;###tramp-autoload
 166 (defun tramp-bug ()
 167   "Submit a bug report to the Tramp developers."
 168   (interactive)
 169   (require 'reporter)
 170   (catch 'dont-send
 171     (let ((reporter-prompt-for-summary-p t))
 172       (reporter-submit-bug-report
 173        tramp-bug-report-address         ; to-address
 174        (format "tramp (%s)" tramp-version) ; package name and version
 175        (sort
 176         (delq nil (mapcar
 177           (lambda (x)
 178             (and x (boundp x) (cons x 'tramp-reporter-dump-variable)))
 179           (append
 180            (mapcar 'intern (all-completions "tramp-" obarray 'boundp))
 181            ;; Non-tramp variables of interest.
 182            '(shell-prompt-pattern
 183              backup-by-copying
 184              backup-by-copying-when-linked
 185              backup-by-copying-when-mismatch
 186              backup-by-copying-when-privileged-mismatch
 187              backup-directory-alist
 188              bkup-backup-directory-info
 189              password-cache
 190              password-cache-expiry
 191              remote-file-name-inhibit-cache
 192              file-name-handler-alist))))
 193         (lambda (x y) (string< (symbol-name (car x)) (symbol-name (car y)))))
 194
 195        'tramp-load-report-modules       ; pre-hook
 196        'tramp-append-tramp-buffers      ; post-hook
 197        (tramp-compat-funcall
 198         (if (functionp 'propertize) 'propertize 'progn)
 199         "\n" 'display "\
 200 Enter your bug report in this message, including as much detail
 201 as you possibly can about the problem, what you did to cause it
 202 and what the local and remote machines are.
 203
 204 If you can give a simple set of instructions to make this bug
 205 happen reliably, please include those.  Thank you for helping
 206 kill bugs in Tramp.
 207
 208 Before reproducing the bug, you might apply
 209
 210   M-x tramp-cleanup-all-connections
 211
 212 This allows to investigate from a clean environment.  Another
 213 useful thing to do is to put
 214
 215   (setq tramp-verbose 9)
 216
 217 in your init file and to repeat the bug.  Then, include the
 218 contents of the *tramp/foo* buffer and the *debug tramp/foo*
 219 buffer in your bug report.
 220
 221 --bug report follows this line--
 222 ")))))
 223
 224 (defun tramp-reporter-dump-variable (varsym mailbuf)
 225   "Pretty-print the value of the variable in symbol VARSYM."
 226   (let* ((reporter-eval-buffer (symbol-value 'reporter-eval-buffer))
 227          (val (with-current-buffer reporter-eval-buffer
 228                 (symbol-value varsym))))
 229
 230     (if (hash-table-p val)
 231         ;; Pretty print the cache.
 232         (set varsym (read (format "(%s)" (tramp-cache-print val))))
 233       ;; There are non-7bit characters to be masked.
 234       (when (and (boundp 'mm-7bit-chars)
 235                  (stringp val)
 236                  (string-match
 237                   (concat "[^" (symbol-value 'mm-7bit-chars) "]") val))
 238         (with-current-buffer reporter-eval-buffer
 239           (set
 240            varsym
 241            (format
 242             "(decode-coding-string (base64-decode-string \"%s\") 'raw-text)"
 243             (base64-encode-string (encode-coding-string val 'raw-text)))))))
 244
 245     ;; Dump variable.
 246     (tramp-compat-funcall 'reporter-dump-variable varsym mailbuf)
 247
 248     (unless (hash-table-p val)
 249       ;; Remove string quotation.
 250       (forward-line -1)
 251       (when (looking-at
 252              (concat "\\(^.*\\)" "\""                       ;; \1 "
 253                      "\\((base64-decode-string \\)" "\\\\"  ;; \2 \
 254                      "\\(\".*\\)" "\\\\"                    ;; \3 \
 255                      "\\(\")\\)" "\"$"))                    ;; \4 "
 256         (replace-match "\\1\\2\\3\\4")
 257         (beginning-of-line)
 258         (insert " ;; Variable encoded due to non-printable characters.\n"))
 259       (forward-line 1))
 260
 261     ;; Reset VARSYM to old value.
 262     (with-current-buffer reporter-eval-buffer
 263       (set varsym val))))
 264
 265 (defun tramp-load-report-modules ()
 266   "Load needed modules for reporting."
 267   ;; We load message.el and mml.el from Gnus.
 268   (if (featurep 'xemacs)
 269       (progn
 270         (load "message" 'noerror)
 271         (load "mml" 'noerror))
 272     (require 'message nil 'noerror)
 273     (require 'mml nil 'noerror))
 274   (tramp-compat-funcall 'message-mode)
 275   (tramp-compat-funcall 'mml-mode t))
 276
 277 (defun tramp-append-tramp-buffers ()
 278   "Append Tramp buffers and buffer local variables into the bug report."
 279   (goto-char (point-max))
 280
 281   ;; Dump buffer local variables.
 282   (insert "\nlocal variables:\n================")
 283   (dolist (buffer
 284            (delq nil
 285                  (mapcar
 286                   (lambda (b)
 287                     (when (string-match "\\*tramp/" (buffer-name b)) b))
 288                   (buffer-list))))
 289     (let ((reporter-eval-buffer buffer)
 290           (elbuf (get-buffer-create " *tmp-reporter-buffer*")))
 291       (with-current-buffer elbuf
 292         (emacs-lisp-mode)
 293         (erase-buffer)
 294         (insert (format "\n;; %s\n(setq-local\n" (buffer-name buffer)))
 295         (lisp-indent-line)
 296         (dolist
 297             (varsym
 298              (sort
 299               (append
 300                (mapcar
 301                 'intern
 302                 (all-completions "tramp-" (buffer-local-variables buffer)))
 303                ;; Non-tramp variables of interest.
 304                '(default-directory))
 305               'string<))
 306             (tramp-compat-funcall 'reporter-dump-variable varsym elbuf))
 307         (lisp-indent-line)
 308         (insert ")\n"))
 309       (insert-buffer-substring elbuf)))
 310
 311   ;; Dump load-path shadows.
 312   (insert "\nload-path shadows:\n==================\n")
 313   (ignore-errors
 314     (mapc
 315      (lambda (x) (when (string-match "tramp" x) (insert x "\n")))
 316      (split-string (tramp-compat-funcall 'list-load-path-shadows t) "\n")))
 317
 318   ;; Append buffers only when we are in message mode.
 319   (when (and
 320          (eq major-mode 'message-mode)
 321          (boundp 'mml-mode)
 322          (symbol-value 'mml-mode))
 323
 324     (let ((tramp-buf-regexp "\\*\\(debug \\)?tramp/")
 325           (buffer-list (tramp-compat-funcall 'tramp-list-tramp-buffers))
 326           (curbuf (current-buffer)))
 327
 328       ;; There is at least one Tramp buffer.
 329       (when buffer-list
 330         (switch-to-buffer (list-buffers-noselect nil))
 331         (delete-other-windows)
 332         (setq buffer-read-only nil)
 333         (goto-char (point-min))
 334         (while (not (eobp))
 335           (if (re-search-forward tramp-buf-regexp (point-at-eol) 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 (tramp-compat-funcall 'propertize "\n" 'display "\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                 (tramp-compat-funcall
 373                  'mml-insert-empty-tag 'part 'type "text/plain"
 374                  'encoding "base64" '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 (add-hook 'tramp-unload-hook
 387           (lambda () (unload-feature 'tramp-cmds 'force)))
 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
 401 ;;; tramp-cmds.el ends here