LCOV - code coverage report
Current view: top level - lisp/net - tramp-cmds.el (source / functions) Hit Total Coverage
Test: tramp-tests.info Lines: 33 177 18.6 %
Date: 2017-08-27 09:44:50 Functions: 7 18 38.9 %

          Line data    Source code
       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           0 :    (let ((input (completing-read
      47           0 :                  "Enter Tramp syntax: " (tramp-syntax-values) nil t
      48           0 :                  (symbol-name tramp-syntax))))
      49           0 :      (unless (string-equal input "")
      50           0 :        (list (intern input)))))
      51          12 :   (when syntax
      52          12 :     (custom-set-variables `(tramp-syntax ',syntax))))
      53             : 
      54             : (defun tramp-list-tramp-buffers ()
      55             :   "Return a list of all Tramp connection buffers."
      56          11 :   (append
      57          11 :    (all-completions
      58          11 :     "*tramp" (mapcar 'list (mapcar 'buffer-name (buffer-list))))
      59          11 :    (all-completions
      60          11 :     "*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          11 :   (delq
      65             :    nil
      66          11 :    (mapcar
      67             :     (lambda (x)
      68        2016 :       (with-current-buffer x (when (tramp-tramp-file-p default-directory) x)))
      69          11 :     (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           0 :    (list
      82           0 :     (let ((connections
      83           0 :            (mapcar
      84             :             (lambda (x)
      85           0 :               (tramp-make-tramp-file-name
      86           0 :                (tramp-file-name-method x)
      87           0 :                (tramp-file-name-user x)
      88           0 :                (tramp-file-name-domain x)
      89           0 :                (tramp-file-name-host x)
      90           0 :                (tramp-file-name-port x)
      91           0 :                (tramp-file-name-localname x)))
      92           0 :             (tramp-list-connections)))
      93             :           name)
      94             : 
      95           0 :       (when connections
      96           0 :         (setq name
      97           0 :               (completing-read
      98           0 :                "Enter Tramp connection: " connections nil t
      99           0 :                (try-completion "" connections)))
     100           0 :         (and (tramp-tramp-file-p name) (tramp-dissect-file-name name))))
     101           0 :     nil nil))
     102             : 
     103          50 :   (if (not vec)
     104             :       ;; Nothing to do.
     105           0 :       (message "No Tramp connection found.")
     106             : 
     107             :     ;; Flush password cache.
     108          50 :     (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          50 :     (when keep-password (setq tramp-current-connection nil))
     114             : 
     115             :     ;; Flush file cache.
     116          50 :     (tramp-flush-directory-property vec "")
     117             : 
     118             :     ;; Flush connection cache.
     119          50 :     (when (processp (tramp-get-connection-process vec))
     120          43 :       (tramp-flush-connection-property (tramp-get-connection-process vec))
     121          50 :       (delete-process (tramp-get-connection-process vec)))
     122          50 :     (tramp-flush-connection-property vec)
     123             : 
     124             :     ;; Remove buffers.
     125          50 :     (dolist
     126          50 :         (buf (list (get-buffer (tramp-buffer-name vec))
     127          50 :                    (unless keep-debug
     128          50 :                      (get-buffer (tramp-debug-buffer-name vec)))
     129          50 :                    (tramp-get-connection-property vec "process-buffer" nil)))
     130         150 :       (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           0 :   (and (tramp-tramp-file-p default-directory)
     137           0 :        (tramp-cleanup-connection
     138           0 :         (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          11 :   (setq tramp-locked nil)
     148             : 
     149             :   ;; Flush password cache.
     150          11 :   (password-reset)
     151             : 
     152             :   ;; Flush file and connection cache.
     153          11 :   (clrhash tramp-cache-data)
     154             : 
     155             :   ;; Remove buffers.
     156          11 :   (dolist (name (tramp-list-tramp-buffers))
     157          11 :     (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          11 :   (tramp-cleanup-all-connections)
     166             : 
     167             :   ;; Remove all buffers with a remote default-directory.
     168          11 :   (dolist (name (tramp-list-remote-buffers))
     169          11 :     (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           0 :   (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           0 :   (catch 'dont-send
     189           0 :     (let ((reporter-prompt-for-summary-p t))
     190           0 :       (reporter-submit-bug-report
     191           0 :        tramp-bug-report-address         ; to-address
     192           0 :        (format "tramp (%s)" tramp-version) ; package name and version
     193           0 :        (sort
     194           0 :         (delq nil (mapcar
     195             :           (lambda (x)
     196           0 :             (and x (boundp x) (cons x 'tramp-reporter-dump-variable)))
     197           0 :           (append
     198           0 :            (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           0 :              file-name-handler-alist))))
     212           0 :         (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           0 :        (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           0 : ")))))
     241             : 
     242             : (defun tramp-reporter-dump-variable (varsym mailbuf)
     243             :   "Pretty-print the value of the variable in symbol VARSYM."
     244           0 :   (let* ((reporter-eval-buffer (symbol-value 'reporter-eval-buffer))
     245           0 :          (val (with-current-buffer reporter-eval-buffer
     246           0 :                 (symbol-value varsym))))
     247             : 
     248           0 :     (if (hash-table-p val)
     249             :         ;; Pretty print the cache.
     250           0 :         (set varsym (read (format "(%s)" (tramp-cache-print val))))
     251             :       ;; There are non-7bit characters to be masked.
     252           0 :       (when (and (stringp val)
     253           0 :                  (string-match
     254           0 :                   (concat "[^" (bound-and-true-p mm-7bit-chars) "]") val))
     255           0 :         (with-current-buffer reporter-eval-buffer
     256           0 :           (set
     257           0 :            varsym
     258           0 :            (format
     259             :             "(decode-coding-string (base64-decode-string \"%s\") 'raw-text)"
     260           0 :             (base64-encode-string (encode-coding-string val 'raw-text)))))))
     261             : 
     262             :     ;; Dump variable.
     263           0 :     (reporter-dump-variable varsym mailbuf)
     264             : 
     265           0 :     (unless (hash-table-p val)
     266             :       ;; Remove string quotation.
     267           0 :       (forward-line -1)
     268           0 :       (when (looking-at
     269           0 :              (concat "\\(^.*\\)" "\""                       ;; \1 "
     270             :                      "\\((base64-decode-string \\)" "\\\\"  ;; \2 \
     271             :                      "\\(\".*\\)" "\\\\"                    ;; \3 \
     272           0 :                      "\\(\")\\)" "\"$"))                    ;; \4 "
     273           0 :         (replace-match "\\1\\2\\3\\4")
     274           0 :         (beginning-of-line)
     275           0 :         (insert " ;; Variable encoded due to non-printable characters.\n"))
     276           0 :       (forward-line 1))
     277             : 
     278             :     ;; Reset VARSYM to old value.
     279           0 :     (with-current-buffer reporter-eval-buffer
     280           0 :       (set varsym val))))
     281             : 
     282             : (defun tramp-load-report-modules ()
     283             :   "Load needed modules for reporting."
     284           0 :   (message-mode)
     285           0 :   (mml-mode t))
     286             : 
     287             : (defun tramp-append-tramp-buffers ()
     288             :   "Append Tramp buffers and buffer local variables into the bug report."
     289           0 :   (goto-char (point-max))
     290             : 
     291             :   ;; Dump buffer local variables.
     292           0 :   (insert "\nlocal variables:\n================")
     293           0 :   (dolist (buffer
     294           0 :            (delq nil
     295           0 :                  (mapcar
     296             :                   (lambda (b)
     297           0 :                     (when (string-match "\\*tramp/" (buffer-name b)) b))
     298           0 :                   (buffer-list))))
     299           0 :     (let ((reporter-eval-buffer buffer)
     300           0 :           (elbuf (get-buffer-create " *tmp-reporter-buffer*")))
     301           0 :       (with-current-buffer elbuf
     302           0 :         (emacs-lisp-mode)
     303           0 :         (erase-buffer)
     304           0 :         (insert (format "\n;; %s\n(setq-local\n" (buffer-name buffer)))
     305           0 :         (lisp-indent-line)
     306           0 :         (dolist
     307             :             (varsym
     308           0 :              (sort
     309           0 :               (append
     310           0 :                (mapcar
     311             :                 'intern
     312           0 :                 (all-completions "tramp-" (buffer-local-variables buffer)))
     313             :                ;; Non-tramp variables of interest.
     314           0 :                '(connection-local-variables-alist default-directory))
     315           0 :               'string<))
     316           0 :             (reporter-dump-variable varsym elbuf))
     317           0 :         (lisp-indent-line)
     318           0 :         (insert ")\n"))
     319           0 :       (insert-buffer-substring elbuf)))
     320             : 
     321             :   ;; Dump load-path shadows.
     322           0 :   (insert "\nload-path shadows:\n==================\n")
     323           0 :   (ignore-errors
     324           0 :     (mapc
     325           0 :      (lambda (x) (when (string-match "tramp" x) (insert x "\n")))
     326           0 :      (split-string (list-load-path-shadows t) "\n")))
     327             : 
     328             :   ;; Append buffers only when we are in message mode.
     329           0 :   (when (and
     330           0 :          (eq major-mode 'message-mode)
     331           0 :          (bound-and-true-p mml-mode))
     332             : 
     333           0 :     (let ((tramp-buf-regexp "\\*\\(debug \\)?tramp/")
     334           0 :           (buffer-list (tramp-list-tramp-buffers))
     335           0 :           (curbuf (current-buffer)))
     336             : 
     337             :       ;; There is at least one Tramp buffer.
     338           0 :       (when buffer-list
     339           0 :         (switch-to-buffer (list-buffers-noselect nil))
     340           0 :         (delete-other-windows)
     341           0 :         (setq buffer-read-only nil)
     342           0 :         (goto-char (point-min))
     343           0 :         (while (not (eobp))
     344           0 :           (if (re-search-forward tramp-buf-regexp (point-at-eol) t)
     345           0 :               (forward-line 1)
     346           0 :             (forward-line 0)
     347           0 :             (let ((start (point)))
     348           0 :               (forward-line 1)
     349           0 :               (kill-region start (point)))))
     350           0 :         (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           0 : names.  Passwords will never be included there.")
     356             : 
     357           0 :         (when (>= tramp-verbose 6)
     358           0 :           (insert "\n\n")
     359           0 :           (let ((start (point)))
     360           0 :             (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           0 : the debug buffer(s).")
     364           0 :             (add-text-properties start (point) '(face italic))))
     365             : 
     366           0 :         (set-buffer-modified-p nil)
     367           0 :         (setq buffer-read-only t)
     368           0 :         (goto-char (point-min))
     369             : 
     370           0 :         (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           0 :             (progn
     373           0 :               (kill-buffer nil)
     374           0 :               (switch-to-buffer curbuf)
     375           0 :               (goto-char (point-max))
     376           0 :               (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           0 : please ensure that the buffers are attached to your email.\n\n"))
     380           0 :               (dolist (buffer buffer-list)
     381           0 :                 (mml-insert-empty-tag
     382             :                  'part 'type "text/plain"
     383           0 :                  'encoding "base64" 'disposition "attachment" 'buffer buffer
     384           0 :                  'description buffer))
     385           0 :               (set-buffer-modified-p nil))
     386             : 
     387             :           ;; Don't send.  Delete the message buffer.
     388           0 :           (set-buffer curbuf)
     389           0 :           (set-buffer-modified-p nil)
     390           0 :           (kill-buffer nil)
     391           0 :           (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

Generated by: LCOV version 1.12