lisp/net/tramp-cmds.el

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