tramp-cmds.el 12 KB

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