lisp/net/tramp-cmds.el

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