tramp-cmds.el 13.9 KB
Newer Older
Michael Albinus's avatar
Michael Albinus committed
1
;;; tramp-cmds.el --- Interactive commands for Tramp  -*- lexical-binding:t -*-
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 2007-2019 Free Software Foundation, Inc.
4 5 6

;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
7
;; Package: tramp
8 9 10

;; This file is part of GNU Emacs.

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 14
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
15 16 17 18 19 20 21

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; 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 25

;;; Commentary:

Paul Eggert's avatar
Paul Eggert committed
26
;; This package provides all interactive commands which are related
27 28 29 30 31 32
;; to Tramp.

;;; Code:

(require 'tramp)

Michael Albinus's avatar
Michael Albinus committed
33
;; Pacify byte-compiler.
34 35 36
(declare-function mml-mode "mml")
(declare-function mml-insert-empty-tag "mml")
(declare-function reporter-dump-variable "reporter")
Michael Albinus's avatar
Michael Albinus committed
37 38
(defvar reporter-eval-buffer)
(defvar reporter-prompt-for-summary-p)
Michael Albinus's avatar
Michael Albinus committed
39

40
;;;###tramp-autoload
Michael Albinus's avatar
Michael Albinus committed
41 42
(defun tramp-change-syntax (&optional syntax)
  "Change Tramp syntax.
Michael Albinus's avatar
Michael Albinus committed
43 44
SYNTAX can be one of the symbols `default' (default),
`simplified' (ange-ftp like) or `separate' (XEmacs like)."
Michael Albinus's avatar
Michael Albinus committed
45 46
  (interactive
   (let ((input (completing-read
Michael Albinus's avatar
Michael Albinus committed
47
		 "Enter Tramp syntax: " (tramp-syntax-values) nil t
Michael Albinus's avatar
Michael Albinus committed
48 49 50 51
		 (symbol-name tramp-syntax))))
     (unless (string-equal input "")
       (list (intern input)))))
  (when syntax
52
    (customize-set-variable 'tramp-syntax syntax)))
Michael Albinus's avatar
Michael Albinus committed
53

54 55 56 57 58 59 60 61 62 63 64 65 66 67
(defun tramp-list-tramp-buffers ()
  "Return a list of all Tramp connection buffers."
  (append
   (all-completions
    "*tramp" (mapcar 'list (mapcar 'buffer-name (buffer-list))))
   (all-completions
    "*debug tramp" (mapcar 'list (mapcar 'buffer-name (buffer-list))))))

(defun tramp-list-remote-buffers ()
  "Return a list of all buffers with remote default-directory."
  (delq
   nil
   (mapcar
    (lambda (x)
Michael Albinus's avatar
Michael Albinus committed
68
      (with-current-buffer x (when (tramp-tramp-file-p default-directory) x)))
69 70
    (buffer-list))))

Michael Albinus's avatar
Michael Albinus committed
71 72 73 74 75
;;;###tramp-autoload
(defvar tramp-cleanup-connection-hook nil
  "List of functions to be called after Tramp connection is cleaned up.
Each function is called with the current vector as argument.")

76
;;;###tramp-autoload
77
(defun tramp-cleanup-connection (vec &optional keep-debug keep-password)
78
  "Flush all connection related objects.
79 80 81
This includes password cache, file cache, connection cache,
buffers.  KEEP-DEBUG non-nil preserves the debug buffer.
KEEP-PASSWORD non-nil preserves the password cache.
82 83 84 85 86 87
When called interactively, a Tramp connection has to be selected."
  (interactive
   ;; When interactive, select the Tramp remote identification.
   ;; Return nil when there is no Tramp connection.
   (list
    (let ((connections
Michael Albinus's avatar
Michael Albinus committed
88
	   (mapcar 'tramp-make-tramp-file-name (tramp-list-connections)))
89 90 91 92 93 94 95
	  name)

      (when connections
	(setq name
	      (completing-read
	       "Enter Tramp connection: " connections nil t
	       (try-completion "" connections)))
Michael Albinus's avatar
Michael Albinus committed
96
	(and (tramp-tramp-file-p name) (tramp-dissect-file-name name))))
97
    nil nil))
98 99 100 101 102 103

  (if (not vec)
      ;; Nothing to do.
      (message "No Tramp connection found.")

    ;; Flush password cache.
104
    (unless keep-password (tramp-clear-passwd vec))
105

106
    ;; Cleanup `tramp-current-connection'.  Otherwise, we would be
Michael Albinus's avatar
Michael Albinus committed
107 108
    ;; suppressed.
    (setq tramp-current-connection nil)
109

110
    ;; Flush file cache.
111
    (tramp-flush-directory-properties vec "")
112 113

    ;; Flush connection cache.
Michael Albinus's avatar
Michael Albinus committed
114
    (when (processp (tramp-get-connection-process vec))
115
      (tramp-flush-connection-properties (tramp-get-connection-process vec))
Michael Albinus's avatar
Michael Albinus committed
116
      (delete-process (tramp-get-connection-process vec)))
117
    (tramp-flush-connection-properties vec)
118 119 120 121

    ;; Remove buffers.
    (dolist
	(buf (list (get-buffer (tramp-buffer-name vec))
122 123
		   (unless keep-debug
		     (get-buffer (tramp-debug-buffer-name vec)))
124
		   (tramp-get-connection-property vec "process-buffer" nil)))
125 126
      (when (bufferp buf) (kill-buffer buf)))

Michael Albinus's avatar
Michael Albinus committed
127 128
    ;; The end.
    (run-hook-with-args 'tramp-cleanup-connection-hook vec)))
129

130 131 132 133
;;;###tramp-autoload
(defun tramp-cleanup-this-connection ()
  "Flush all connection related objects of the current buffer's connection."
  (interactive)
Michael Albinus's avatar
Michael Albinus committed
134
  (and (tramp-tramp-file-p default-directory)
135 136 137
       (tramp-cleanup-connection
	(tramp-dissect-file-name default-directory 'noexpand))))

Michael Albinus's avatar
Michael Albinus committed
138 139 140 141
;;;###tramp-autoload
(defvar tramp-cleanup-all-connections-hook nil
  "List of functions to be called after all Tramp connections are cleaned up.")

142
;;;###tramp-autoload
143 144 145 146 147
(defun tramp-cleanup-all-connections ()
  "Flush all Tramp internal objects.
This includes password cache, file cache, connection cache, buffers."
  (interactive)

148 149 150
  ;; Unlock Tramp.
  (setq tramp-locked nil)

151
  ;; Flush password cache.
152
  (password-reset)
153 154 155 156

  ;; Flush file and connection cache.
  (clrhash tramp-cache-data)

157 158 159 160 161 162 163 164 165 166 167 168 169
  ;; Remove ad-hoc proxies.
  (let ((proxies tramp-default-proxies-alist))
    (while proxies
      (if (ignore-errors
	    (get-text-property 0 'tramp-ad-hoc (nth 2 (car proxies))))
	  (setq tramp-default-proxies-alist
		(delete (car proxies) tramp-default-proxies-alist)
		proxies tramp-default-proxies-alist)
	(setq proxies (cdr proxies)))))
    (when (and tramp-default-proxies-alist tramp-save-ad-hoc-proxies)
      (customize-save-variable
       'tramp-default-proxies-alist tramp-default-proxies-alist))

170 171
  ;; Remove buffers.
  (dolist (name (tramp-list-tramp-buffers))
172 173
    (when (bufferp (get-buffer name)) (kill-buffer name)))

Michael Albinus's avatar
Michael Albinus committed
174 175
  ;; The end.
  (run-hooks 'tramp-cleanup-all-connections-hook))
176

177
;;;###tramp-autoload
178 179 180 181
(defun tramp-cleanup-all-buffers ()
  "Kill all remote buffers."
  (interactive)

182
  ;; Remove all Tramp related connections.
183 184 185 186 187 188
  (tramp-cleanup-all-connections)

  ;; Remove all buffers with a remote default-directory.
  (dolist (name (tramp-list-remote-buffers))
    (when (bufferp (get-buffer name)) (kill-buffer name))))

189 190
;; Tramp version is useful in a number of situations.

191
;;;###tramp-autoload
192 193 194 195 196
(defun tramp-version (arg)
  "Print version number of tramp.el in minibuffer or current buffer."
  (interactive "P")
  (if arg (insert tramp-version) (message tramp-version)))

197
;; Make the "reporter" functionality available for making bug reports about
198
;; the package.  A most useful piece of code.
199 200 201

(autoload 'reporter-submit-bug-report "reporter")

202
;;;###tramp-autoload
203 204 205 206
(defun tramp-bug ()
  "Submit a bug report to the Tramp developers."
  (interactive)
  (catch 'dont-send
Michael Albinus's avatar
Michael Albinus committed
207 208 209
    (let ((reporter-prompt-for-summary-p t)
	  ;; In rare cases, it could contain the password.  So we make it nil.
	  tramp-password-save-function)
210
      (reporter-submit-bug-report
211 212 213
       tramp-bug-report-address	  ; to-address
       (format "tramp (%s %s/%s)" ; package name and version
	       tramp-version tramp-repository-branch tramp-repository-version)
214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229
       (sort
	(delq nil (mapcar
	  (lambda (x)
	    (and x (boundp x) (cons x 'tramp-reporter-dump-variable)))
	  (append
	   (mapcar 'intern (all-completions "tramp-" obarray 'boundp))
	   ;; Non-tramp variables of interest.
	   '(shell-prompt-pattern
	     backup-by-copying
	     backup-by-copying-when-linked
	     backup-by-copying-when-mismatch
	     backup-by-copying-when-privileged-mismatch
	     backup-directory-alist
	     password-cache
	     password-cache-expiry
	     remote-file-name-inhibit-cache
230
	     connection-local-profile-alist
231
	     connection-local-criteria-alist
232 233
	     file-name-handler-alist))))
	(lambda (x y) (string< (symbol-name (car x)) (symbol-name (car y)))))
234 235 236

       'tramp-load-report-modules	; pre-hook
       'tramp-append-tramp-buffers	; post-hook
237
       (propertize
238
	"\n" 'display "\
239 240 241 242 243 244 245 246
Enter your bug report in this message, including as much detail
as you possibly can about the problem, what you did to cause it
and what the local and remote machines are.

If you can give a simple set of instructions to make this bug
happen reliably, please include those.  Thank you for helping
kill bugs in Tramp.

247 248 249 250
Before reproducing the bug, you might apply

  M-x tramp-cleanup-all-connections

251
This allows us to investigate from a clean environment.  Another
252
useful thing to do is to put
253

254
  (setq tramp-verbose 9)
255

256
in your init file and to repeat the bug.  Then, include the
257 258 259 260
contents of the *tramp/foo* buffer and the *debug tramp/foo*
buffer in your bug report.

--bug report follows this line--
261
")))))
262 263

(defun tramp-reporter-dump-variable (varsym mailbuf)
264
  "Pretty-print the value of the variable in symbol VARSYM."
265 266 267 268 269 270 271
  (let* ((reporter-eval-buffer (symbol-value 'reporter-eval-buffer))
	 (val (with-current-buffer reporter-eval-buffer
		(symbol-value varsym))))

    (if (hash-table-p val)
	;; Pretty print the cache.
	(set varsym (read (format "(%s)" (tramp-cache-print val))))
272
      ;; There are non-7bit characters to be masked.
273
      (when (and (stringp val)
274
		 (string-match-p
275
		  (concat "[^" (bound-and-true-p mm-7bit-chars) "]") val))
276
	(with-current-buffer reporter-eval-buffer
277 278 279 280 281
	  (set
	   varsym
	   (format
	    "(decode-coding-string (base64-decode-string \"%s\") 'raw-text)"
	    (base64-encode-string (encode-coding-string val 'raw-text)))))))
282 283

    ;; Dump variable.
284
    (reporter-dump-variable varsym mailbuf)
285 286 287 288 289

    (unless (hash-table-p val)
      ;; Remove string quotation.
      (forward-line -1)
      (when (looking-at
290 291 292 293 294
	     (eval-when-compile
	       (concat "\\(^.*\\)" "\""                       ;; \1 "
		       "\\((base64-decode-string \\)" "\\\\"  ;; \2 \
		       "\\(\".*\\)" "\\\\"                    ;; \3 \
		       "\\(\")\\)" "\"$")))                   ;; \4 "
295 296
	(replace-match "\\1\\2\\3\\4")
	(beginning-of-line)
297
	(insert " ;; Variable encoded due to non-printable characters.\n"))
298 299 300 301 302 303 304 305
      (forward-line 1))

    ;; Reset VARSYM to old value.
    (with-current-buffer reporter-eval-buffer
      (set varsym val))))

(defun tramp-load-report-modules ()
  "Load needed modules for reporting."
306 307
  (message-mode)
  (mml-mode t))
308 309 310 311 312 313

(defun tramp-append-tramp-buffers ()
  "Append Tramp buffers and buffer local variables into the bug report."
  (goto-char (point-max))

  ;; Dump buffer local variables.
314
  (insert "\nlocal variables:\n================")
315 316 317
  (dolist (buffer
	   (delq nil
		 (mapcar
318
		  (lambda (b)
319
                    (when (string-match-p "\\*tramp/" (buffer-name b)) b))
320 321 322 323 324 325
		  (buffer-list))))
    (let ((reporter-eval-buffer buffer)
	  (elbuf (get-buffer-create " *tmp-reporter-buffer*")))
      (with-current-buffer elbuf
	(emacs-lisp-mode)
	(erase-buffer)
326
	(insert (format "\n;; %s\n(setq-local\n" (buffer-name buffer)))
327
	(lisp-indent-line)
328 329 330 331 332 333 334 335
	(dolist
	    (varsym
	     (sort
	      (append
	       (mapcar
		'intern
		(all-completions "tramp-" (buffer-local-variables buffer)))
	       ;; Non-tramp variables of interest.
336
	       '(connection-local-variables-alist default-directory))
337
	      'string<))
338
	    (reporter-dump-variable varsym elbuf))
339 340 341 342
	(lisp-indent-line)
	(insert ")\n"))
      (insert-buffer-substring elbuf)))

343 344 345
  ;; Dump load-path shadows.
  (insert "\nload-path shadows:\n==================\n")
  (ignore-errors
Michael Albinus's avatar
Michael Albinus committed
346
    (mapc
347
     (lambda (x) (when (string-match-p "tramp" x) (insert x "\n")))
348
     (split-string (list-load-path-shadows t) "\n")))
349

350 351 352
  ;; Append buffers only when we are in message mode.
  (when (and
	 (eq major-mode 'message-mode)
353
	 (bound-and-true-p mml-mode))
354 355

    (let ((tramp-buf-regexp "\\*\\(debug \\)?tramp/")
356
	  (buffer-list (tramp-list-tramp-buffers))
357 358 359 360
	  (curbuf (current-buffer)))

      ;; There is at least one Tramp buffer.
      (when buffer-list
361
	(switch-to-buffer (list-buffers-noselect nil))
362 363 364 365
	(delete-other-windows)
	(setq buffer-read-only nil)
	(goto-char (point-min))
	(while (not (eobp))
366
	  (if (re-search-forward tramp-buf-regexp (point-at-eol) t)
367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385
	      (forward-line 1)
	    (forward-line 0)
	    (let ((start (point)))
	      (forward-line 1)
	      (kill-region start (point)))))
	(insert "
The buffer(s) above will be appended to this message.  If you
don't want to append a buffer because it contains sensitive data,
or because the buffer is too large, you should delete the
respective buffer.  The buffer(s) will contain user and host
names.  Passwords will never be included there.")

	(when (>= tramp-verbose 6)
	  (insert "\n\n")
	  (let ((start (point)))
	    (insert "\
Please note that you have set `tramp-verbose' to a value of at
least 6.  Therefore, the contents of files might be included in
the debug buffer(s).")
386
	    (add-text-properties start (point) '(face italic))))
387 388 389 390 391 392 393 394 395

	(set-buffer-modified-p nil)
	(setq buffer-read-only t)
	(goto-char (point-min))

	(if (y-or-n-p "Do you want to append the buffer(s)? ")
	    ;; OK, let's send.  First we delete the buffer list.
	    (progn
	      (kill-buffer nil)
396
	      (switch-to-buffer curbuf)
397
	      (goto-char (point-max))
398
	      (insert (propertize "\n" 'display "\n\
399 400
This is a special notion of the `gnus/message' package.  If you
use another mail agent (by copying the contents of this buffer)
401
please ensure that the buffers are attached to your email.\n\n"))
402
	      (dolist (buffer buffer-list)
403 404
		(mml-insert-empty-tag
		 'part 'type "text/plain"
405 406
		 'encoding "base64" 'disposition "attachment" 'buffer buffer
		 'description buffer))
407 408 409 410 411 412 413 414 415 416
	      (set-buffer-modified-p nil))

	  ;; Don't send.  Delete the message buffer.
	  (set-buffer curbuf)
	  (set-buffer-modified-p nil)
	  (kill-buffer nil)
	  (throw 'dont-send nil))))))

(defalias 'tramp-submit-bug 'tramp-bug)

417 418 419
(add-hook 'tramp-unload-hook
	  (lambda () (unload-feature 'tramp-cmds 'force)))

420 421 422 423 424
(provide 'tramp-cmds)

;;; TODO:

;; * Clean up unused *tramp/foo* buffers after a while.  (Pete Forman)
Michael Albinus's avatar
Michael Albinus committed
425
;;
426
;; * WIBNI there was an interactive command prompting for Tramp
427 428
;;   method, hostname, username and filename and translates the user
;;   input into the correct filename syntax (depending on the Emacs
429
;;   flavor)  (Reiner Steib)
Michael Albinus's avatar
Michael Albinus committed
430
;;
431 432 433 434
;; * Let the user edit the connection properties interactively.
;;   Something like `gnus-server-edit-server' in Gnus' *Server* buffer.

;;; tramp-cmds.el ends here