4 |
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
5 |
;; 2005 Free Software Foundation, Inc. |
;; 2005 Free Software Foundation, Inc. |
6 |
|
|
7 |
;; Author: kai.grossjohann@gmx.net |
;; Author: Kai Gro,A_(Bjohann <kai.grossjohann@gmx.net> |
8 |
|
;; Michael Albinus <michael.albinus@gmx.de> |
9 |
;; Keywords: comm, processes |
;; Keywords: comm, processes |
10 |
|
|
11 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
148 |
(when (boundp 'byte-compile-not-obsolete-var) |
(when (boundp 'byte-compile-not-obsolete-var) |
149 |
(setq byte-compile-not-obsolete-var 'directory-sep-char))) |
(setq byte-compile-not-obsolete-var 'directory-sep-char))) |
150 |
|
|
|
;; XEmacs byte-compiler raises warning abouts `last-coding-system-used'. |
|
|
(eval-when-compile |
|
|
(unless (boundp 'last-coding-system-used) |
|
|
(defvar last-coding-system-used nil))) |
|
|
|
|
151 |
;;; User Customizable Internal Variables: |
;;; User Customizable Internal Variables: |
152 |
|
|
153 |
(defgroup tramp nil |
(defgroup tramp nil |
1027 |
:type 'regexp) |
:type 'regexp) |
1028 |
|
|
1029 |
(defcustom tramp-user-regexp |
(defcustom tramp-user-regexp |
1030 |
"[^:@/ \t]*" |
"[^:/ \t]*" |
1031 |
"*Regexp matching user names." |
"*Regexp matching user names." |
1032 |
:group 'tramp |
:group 'tramp |
1033 |
:type 'regexp) |
:type 'regexp) |
1910 |
tramp-current-multi-method tramp-current-method |
tramp-current-multi-method tramp-current-method |
1911 |
tramp-current-user tramp-current-host)) |
tramp-current-user tramp-current-host)) |
1912 |
(goto-char (point-max)) |
(goto-char (point-max)) |
1913 |
(tramp-insert-with-face |
(unless (bolp) |
1914 |
|
(insert "\n")) |
1915 |
|
(tramp-insert-with-face |
1916 |
'italic |
'italic |
1917 |
(concat "# " (apply #'format fmt-string args) "\n")))))) |
(concat "# " (apply #'format fmt-string args) "\n")))))) |
1918 |
|
|
2368 |
(buffer-name))) |
(buffer-name))) |
2369 |
(if time-list |
(if time-list |
2370 |
(tramp-run-real-handler 'set-visited-file-modtime (list time-list)) |
(tramp-run-real-handler 'set-visited-file-modtime (list time-list)) |
2371 |
(let ((f (buffer-file-name)) |
(let ((f (buffer-file-name))) |
|
(coding-system-used nil)) |
|
2372 |
(with-parsed-tramp-file-name f nil |
(with-parsed-tramp-file-name f nil |
2373 |
(let* ((attr (file-attributes f)) |
(let* ((attr (file-attributes f)) |
2374 |
;; '(-1 65535) means file doesn't exists yet. |
;; '(-1 65535) means file doesn't exists yet. |
2375 |
(modtime (or (nth 5 attr) '(-1 65535)))) |
(modtime (or (nth 5 attr) '(-1 65535)))) |
2376 |
;; We use '(0 0) as a don't-know value. See also |
;; We use '(0 0) as a don't-know value. See also |
2377 |
;; `tramp-handle-file-attributes-with-ls'. |
;; `tramp-handle-file-attributes-with-ls'. |
|
(when (boundp 'last-coding-system-used) |
|
|
(setq coding-system-used last-coding-system-used)) |
|
2378 |
(if (not (equal modtime '(0 0))) |
(if (not (equal modtime '(0 0))) |
2379 |
(tramp-run-real-handler 'set-visited-file-modtime (list modtime)) |
(tramp-run-real-handler 'set-visited-file-modtime (list modtime)) |
2380 |
(save-excursion |
(save-excursion |
2387 |
(setq attr (buffer-substring (point) |
(setq attr (buffer-substring (point) |
2388 |
(progn (end-of-line) (point))))) |
(progn (end-of-line) (point))))) |
2389 |
(setq tramp-buffer-file-attributes attr)) |
(setq tramp-buffer-file-attributes attr)) |
2390 |
(when (boundp 'last-coding-system-used) |
nil))))) |
|
(setq last-coding-system-used coding-system-used)) |
|
|
nil))))) |
|
2391 |
|
|
2392 |
;; CCC continue here |
;; CCC continue here |
2393 |
|
|
2405 |
;; recorded last modification time. |
;; recorded last modification time. |
2406 |
(if (or (not (buffer-file-name)) |
(if (or (not (buffer-file-name)) |
2407 |
(eq (visited-file-modtime) 0)) |
(eq (visited-file-modtime) 0)) |
2408 |
t |
t |
2409 |
(let ((f (buffer-file-name))) |
(let ((f (buffer-file-name))) |
2410 |
(with-parsed-tramp-file-name f nil |
(with-parsed-tramp-file-name f nil |
2411 |
(let* ((attr (file-attributes f)) |
(let* ((attr (file-attributes f)) |
2440 |
;; if and only if that agrees with the buffer's record. |
;; if and only if that agrees with the buffer's record. |
2441 |
(t (equal mt '(-1 65535)))))))))) |
(t (equal mt '(-1 65535)))))))))) |
2442 |
|
|
|
(defadvice clear-visited-file-modtime (after tramp activate) |
|
|
"Set `tramp-buffer-file-attributes' back to nil. |
|
|
Tramp uses this variable as an emulation for the actual modtime of the file, |
|
|
if the remote host can't provide the modtime." |
|
|
(setq tramp-buffer-file-attributes nil)) |
|
|
|
|
2443 |
(defun tramp-handle-set-file-modes (filename mode) |
(defun tramp-handle-set-file-modes (filename mode) |
2444 |
"Like `set-file-modes' for tramp files." |
"Like `set-file-modes' for tramp files." |
2445 |
(with-parsed-tramp-file-name filename nil |
(with-parsed-tramp-file-name filename nil |
3124 |
tramp-current-method method |
tramp-current-method method |
3125 |
tramp-current-user user |
tramp-current-user user |
3126 |
tramp-current-host host) |
tramp-current-host host) |
3127 |
(tramp-message |
(message "Transferring %s to %s..." filename newname) |
|
5 "Transferring %s to file %s..." filename newname) |
|
3128 |
|
|
3129 |
;; Use rcp-like program for file transfer. |
;; Use rcp-like program for file transfer. |
3130 |
(let ((p (apply 'start-process (buffer-name trampbuf) trampbuf |
(let ((p (apply 'start-process (buffer-name trampbuf) trampbuf |
3133 |
(tramp-process-actions p multi-method method user host |
(tramp-process-actions p multi-method method user host |
3134 |
tramp-actions-copy-out-of-band)) |
tramp-actions-copy-out-of-band)) |
3135 |
(kill-buffer trampbuf) |
(kill-buffer trampbuf) |
3136 |
(tramp-message |
(message "Transferring %s to %s...done" filename newname) |
|
5 "Transferring %s to file %s...done" filename newname) |
|
3137 |
|
|
3138 |
;; Set the mode. |
;; Set the mode. |
3139 |
(unless keep-date |
(unless keep-date |
3304 |
(filename switches &optional wildcard full-directory-p) |
(filename switches &optional wildcard full-directory-p) |
3305 |
"Like `insert-directory' for tramp files." |
"Like `insert-directory' for tramp files." |
3306 |
(if (and (boundp 'ls-lisp-use-insert-directory-program) |
(if (and (boundp 'ls-lisp-use-insert-directory-program) |
3307 |
(not ls-lisp-use-insert-directory-program)) |
(not (symbol-value 'ls-lisp-use-insert-directory-program))) |
3308 |
(tramp-run-real-handler 'insert-directory |
(tramp-run-real-handler 'insert-directory |
3309 |
(list filename switches wildcard full-directory-p)) |
(list filename switches wildcard full-directory-p)) |
3310 |
;; For the moment, we assume that the remote "ls" program does not |
;; For the moment, we assume that the remote "ls" program does not |
3490 |
;; Remote commands. |
;; Remote commands. |
3491 |
|
|
3492 |
(defvar tramp-async-proc nil |
(defvar tramp-async-proc nil |
3493 |
"Global variable keeping asyncronous process object. |
"Global variable keeping asynchronous process object. |
3494 |
Used in `tramp-handle-shell-command'") |
Used in `tramp-handle-shell-command'") |
3495 |
|
|
3496 |
(defun tramp-handle-shell-command (command &optional output-buffer error-buffer) |
(defun tramp-handle-shell-command (command &optional output-buffer error-buffer) |
3747 |
'insert-file-contents) |
'insert-file-contents) |
3748 |
'file-local-copy))) |
'file-local-copy))) |
3749 |
(file-local-copy filename))) |
(file-local-copy filename))) |
|
(coding-system-used nil) |
|
3750 |
(result nil)) |
(result nil)) |
3751 |
(when visit |
(when visit |
3752 |
(setq buffer-file-name filename) |
(setq buffer-file-name filename) |
3756 |
multi-method method user host |
multi-method method user host |
3757 |
9 "Inserting local temp file `%s'..." local-copy) |
9 "Inserting local temp file `%s'..." local-copy) |
3758 |
(setq result (insert-file-contents local-copy nil beg end replace)) |
(setq result (insert-file-contents local-copy nil beg end replace)) |
|
;; Now `last-coding-system-used' has right value. Remember it. |
|
|
(when (boundp 'last-coding-system-used) |
|
|
(setq coding-system-used last-coding-system-used)) |
|
3759 |
(tramp-message-for-buffer |
(tramp-message-for-buffer |
3760 |
multi-method method user host |
multi-method method user host |
3761 |
9 "Inserting local temp file `%s'...done" local-copy) |
9 "Inserting local temp file `%s'...done" local-copy) |
3762 |
(delete-file local-copy) |
(delete-file local-copy) |
|
(when (boundp 'last-coding-system-used) |
|
|
(setq last-coding-system-used coding-system-used)) |
|
3763 |
(list (expand-file-name filename) |
(list (expand-file-name filename) |
3764 |
(second result)))))) |
(second result)))))) |
3765 |
|
|
3824 |
;; (string= lockname filename)) |
;; (string= lockname filename)) |
3825 |
;; (error |
;; (error |
3826 |
;; "tramp-handle-write-region: LOCKNAME must be nil or equal FILENAME")) |
;; "tramp-handle-write-region: LOCKNAME must be nil or equal FILENAME")) |
3827 |
;; XEmacs takes a coding system as the sevent argument, not `confirm' |
;; XEmacs takes a coding system as the seventh argument, not `confirm' |
3828 |
(when (and (not (featurep 'xemacs)) |
(when (and (not (featurep 'xemacs)) |
3829 |
confirm (file-exists-p filename)) |
confirm (file-exists-p filename)) |
3830 |
(unless (y-or-n-p (format "File %s exists; overwrite anyway? " |
(unless (y-or-n-p (format "File %s exists; overwrite anyway? " |
3838 |
(loc-dec (tramp-get-local-decoding multi-method method user host)) |
(loc-dec (tramp-get-local-decoding multi-method method user host)) |
3839 |
(trampbuf (get-buffer-create "*tramp output*")) |
(trampbuf (get-buffer-create "*tramp output*")) |
3840 |
(modes (file-modes filename)) |
(modes (file-modes filename)) |
|
;; We use this to save the value of `last-coding-system-used' |
|
|
;; after writing the tmp file. At the end of the function, |
|
|
;; we set `last-coding-system-used' to this saved value. |
|
|
;; This way, any intermediary coding systems used while |
|
|
;; talking to the remote shell or suchlike won't hose this |
|
|
;; variable. This approach was snarfed from ange-ftp.el. |
|
|
coding-system-used |
|
3841 |
tmpfil) |
tmpfil) |
3842 |
;; Write region into a tmp file. This isn't really needed if we |
;; Write region into a tmp file. This isn't really needed if we |
3843 |
;; use an encoding function, but currently we use it always |
;; use an encoding function, but currently we use it always |
3859 |
;; the backup file. This case `save-buffer' handles |
;; the backup file. This case `save-buffer' handles |
3860 |
;; permissions. |
;; permissions. |
3861 |
(when modes (set-file-modes tmpfil modes)) |
(when modes (set-file-modes tmpfil modes)) |
|
;; Now, `last-coding-system-used' has the right value. Remember it. |
|
|
(when (boundp 'last-coding-system-used) |
|
|
(setq coding-system-used last-coding-system-used)) |
|
3862 |
;; This is a bit lengthy due to the different methods possible for |
;; This is a bit lengthy due to the different methods possible for |
3863 |
;; file transfer. First, we check whether the method uses an rcp |
;; file transfer. First, we check whether the method uses an rcp |
3864 |
;; program. If so, we call it. Otherwise, both encoding and |
;; program. If so, we call it. Otherwise, both encoding and |
3960 |
;; We must pass modtime explicitely, because filename can be different |
;; We must pass modtime explicitely, because filename can be different |
3961 |
;; from (buffer-file-name), f.e. if `file-precious-flag' is set. |
;; from (buffer-file-name), f.e. if `file-precious-flag' is set. |
3962 |
(nth 5 (file-attributes filename)))) |
(nth 5 (file-attributes filename)))) |
|
;; Make `last-coding-system-used' have the right value. |
|
|
(when (boundp 'last-coding-system-used) |
|
|
(setq last-coding-system-used coding-system-used)) |
|
3963 |
(when (or (eq visit t) |
(when (or (eq visit t) |
3964 |
(eq visit nil) |
(eq visit nil) |
3965 |
(stringp visit)) |
(stringp visit)) |
4267 |
(symbol-function 'PC-expand-many-files)) |
(symbol-function 'PC-expand-many-files)) |
4268 |
(defun PC-expand-many-files (name) |
(defun PC-expand-many-files (name) |
4269 |
(if (tramp-tramp-file-p name) |
(if (tramp-tramp-file-p name) |
4270 |
(expand-many-files name) |
(funcall (symbol-function 'expand-many-files) name) |
4271 |
(tramp-save-PC-expand-many-files name)))) |
(tramp-save-PC-expand-many-files name)))) |
4272 |
|
|
4273 |
;; Why isn't eval-after-load sufficient? |
;; Why isn't eval-after-load sufficient? |
4791 |
(defun tramp-completion-handle-expand-file-name (name &optional dir) |
(defun tramp-completion-handle-expand-file-name (name &optional dir) |
4792 |
"Like `expand-file-name' for tramp files." |
"Like `expand-file-name' for tramp files." |
4793 |
(let ((fullname (concat (or dir default-directory) name))) |
(let ((fullname (concat (or dir default-directory) name))) |
4794 |
(tramp-drop-volume-letter |
(if (tramp-completion-mode fullname) |
4795 |
(if (tramp-completion-mode fullname) |
(tramp-run-real-handler |
4796 |
(tramp-run-real-handler |
'expand-file-name (list name dir)) |
4797 |
'expand-file-name (list name dir)) |
(tramp-completion-run-real-handler |
4798 |
(tramp-completion-run-real-handler |
'expand-file-name (list name dir))))) |
|
'expand-file-name (list name dir)))))) |
|
4799 |
|
|
4800 |
;;; Internal Functions: |
;;; Internal Functions: |
4801 |
|
|
5092 |
(tramp-send-command |
(tramp-send-command |
5093 |
multi-method method user host |
multi-method method user host |
5094 |
(concat "PS1='$ ' exec " shell)) ; |
(concat "PS1='$ ' exec " shell)) ; |
5095 |
(unless (tramp-wait-for-regexp |
(tramp-barf-if-no-shell-prompt |
5096 |
(get-buffer-process (current-buffer)) |
(get-buffer-process (current-buffer)) |
5097 |
60 (format "\\(\\(%s\\)\\|\\(%s\\)\\)\\'" |
60 "Couldn't find remote `%s' prompt" shell) |
|
tramp-shell-prompt-pattern shell-prompt-pattern)) |
|
|
(pop-to-buffer (buffer-name)) |
|
|
(error "Couldn't find remote `%s' prompt" shell)) |
|
5098 |
(tramp-message |
(tramp-message |
5099 |
9 "Setting remote shell prompt...") |
9 "Setting remote shell prompt...") |
5100 |
;; Douglas Gray Stephens <DGrayStephens@slb.com> says that we |
;; Douglas Gray Stephens <DGrayStephens@slb.com> says that we |
5293 |
(tramp-message 9 "Waiting 60s for prompt from remote shell") |
(tramp-message 9 "Waiting 60s for prompt from remote shell") |
5294 |
(with-timeout (60 (throw 'tramp-action 'timeout)) |
(with-timeout (60 (throw 'tramp-action 'timeout)) |
5295 |
(while (not found) |
(while (not found) |
5296 |
(accept-process-output p 1) |
(tramp-accept-process-output p 1) |
5297 |
(goto-char (point-min)) |
(goto-char (point-min)) |
5298 |
(setq todo actions) |
(setq todo actions) |
5299 |
(while todo |
(while todo |
5330 |
(tramp-message 9 "Waiting 60s for prompt from remote shell") |
(tramp-message 9 "Waiting 60s for prompt from remote shell") |
5331 |
(with-timeout (60 (throw 'tramp-action 'timeout)) |
(with-timeout (60 (throw 'tramp-action 'timeout)) |
5332 |
(while (not found) |
(while (not found) |
5333 |
(accept-process-output p 1) |
(tramp-accept-process-output p 1) |
5334 |
(setq todo actions) |
(setq todo actions) |
5335 |
(goto-char (point-min)) |
(goto-char (point-min)) |
5336 |
(while todo |
(while todo |
5719 |
|
|
5720 |
;; Utility functions. |
;; Utility functions. |
5721 |
|
|
5722 |
|
(defun tramp-accept-process-output |
5723 |
|
(&optional process timeout timeout-msecs) |
5724 |
|
"Like `accept-process-output' for Tramp processes. |
5725 |
|
This is needed in order to hide `last-coding-system-used', which is set |
5726 |
|
for process communication also." |
5727 |
|
(let (last-coding-system-used) |
5728 |
|
(accept-process-output process timeout timeout-msecs))) |
5729 |
|
|
5730 |
(defun tramp-wait-for-regexp (proc timeout regexp) |
(defun tramp-wait-for-regexp (proc timeout regexp) |
5731 |
"Wait for a REGEXP to appear from process PROC within TIMEOUT seconds. |
"Wait for a REGEXP to appear from process PROC within TIMEOUT seconds. |
5732 |
Expects the output of PROC to be sent to the current buffer. Returns |
Expects the output of PROC to be sent to the current buffer. Returns |
5743 |
timeout)) |
timeout)) |
5744 |
(with-timeout (timeout) |
(with-timeout (timeout) |
5745 |
(while (not found) |
(while (not found) |
5746 |
(accept-process-output proc 1) |
(tramp-accept-process-output proc 1) |
5747 |
(unless (memq (process-status proc) '(run open)) |
(unless (memq (process-status proc) '(run open)) |
5748 |
(error "Process has died")) |
(error "Process has died")) |
5749 |
(goto-char (point-min)) |
(goto-char (point-min)) |
5750 |
(setq found (when (re-search-forward regexp nil t) |
(setq found (re-search-forward regexp nil t)))))) |
|
(tramp-match-string-list))))))) |
|
5751 |
(t |
(t |
5752 |
(while (not found) |
(while (not found) |
5753 |
(accept-process-output proc 1) |
(tramp-accept-process-output proc 1) |
5754 |
(unless (memq (process-status proc) '(run open)) |
(unless (memq (process-status proc) '(run open)) |
5755 |
(error "Process has died")) |
(error "Process has died")) |
5756 |
(goto-char (point-min)) |
(goto-char (point-min)) |
5757 |
(setq found (when (re-search-forward regexp nil t) |
(setq found (re-search-forward regexp nil t))))) |
|
(tramp-match-string-list)))))) |
|
5758 |
(when tramp-debug-buffer |
(when tramp-debug-buffer |
5759 |
(append-to-buffer |
(append-to-buffer |
5760 |
(tramp-get-debug-buffer tramp-current-multi-method tramp-current-method |
(tramp-get-debug-buffer tramp-current-multi-method tramp-current-method |
6367 |
timeout)) |
timeout)) |
6368 |
(with-timeout (timeout) |
(with-timeout (timeout) |
6369 |
(while (not found) |
(while (not found) |
6370 |
(accept-process-output proc 1) |
(tramp-accept-process-output proc 1) |
6371 |
(unless (memq (process-status proc) '(run open)) |
(unless (memq (process-status proc) '(run open)) |
6372 |
(error "Process has died")) |
(error "Process has died")) |
6373 |
(goto-char (point-max)) |
(goto-char (point-max)) |
6375 |
(setq found (looking-at end-of-output)))))) |
(setq found (looking-at end-of-output)))))) |
6376 |
(t |
(t |
6377 |
(while (not found) |
(while (not found) |
6378 |
(accept-process-output proc 1) |
(tramp-accept-process-output proc 1) |
6379 |
(unless (memq (process-status proc) '(run open)) |
(unless (memq (process-status proc) '(run open)) |
6380 |
(error "Process has died")) |
(error "Process has died")) |
6381 |
(goto-char (point-max)) |
(goto-char (point-max)) |
6412 |
;; Return value is whether end-of-output sentinel was found. |
;; Return value is whether end-of-output sentinel was found. |
6413 |
found)) |
found)) |
6414 |
|
|
|
(defun tramp-match-string-list (&optional string) |
|
|
"Returns list of all match strings. |
|
|
That is, (list (match-string 0) (match-string 1) ...), according to the |
|
|
number of matches." |
|
|
(let* ((nmatches (/ (length (match-data)) 2)) |
|
|
(i (- nmatches 1)) |
|
|
(res nil)) |
|
|
(while (>= i 0) |
|
|
(setq res (cons (match-string i string) res)) |
|
|
(setq i (- i 1))) |
|
|
res)) |
|
|
|
|
6415 |
(defun tramp-send-command-and-check (multi-method method user host command |
(defun tramp-send-command-and-check (multi-method method user host command |
6416 |
&optional subshell) |
&optional subshell) |
6417 |
"Run COMMAND and check its exit status. |
"Run COMMAND and check its exit status. |
6512 |
If `tramp-discard-garbage' is nil, just erase buffer." |
If `tramp-discard-garbage' is nil, just erase buffer." |
6513 |
(if (not tramp-discard-garbage) |
(if (not tramp-discard-garbage) |
6514 |
(erase-buffer) |
(erase-buffer) |
6515 |
(while (prog1 (erase-buffer) (accept-process-output p 0.25)) |
(while (prog1 (erase-buffer) (tramp-accept-process-output p 0.25)) |
6516 |
(when tramp-debug-buffer |
(when tramp-debug-buffer |
6517 |
(save-excursion |
(save-excursion |
6518 |
(set-buffer (tramp-get-debug-buffer multi-method method user host)) |
(set-buffer (tramp-get-debug-buffer multi-method method user host)) |
6949 |
;; auto-saved file belonging to another original file. This could |
;; auto-saved file belonging to another original file. This could |
6950 |
;; be a security threat. |
;; be a security threat. |
6951 |
(set-file-modes buffer-auto-save-file-name |
(set-file-modes buffer-auto-save-file-name |
6952 |
(or (file-modes bfn) ?\600))))) |
(or (file-modes bfn) #o600))))) |
6953 |
|
|
6954 |
(unless (or (> emacs-major-version 21) |
(unless (or (> emacs-major-version 21) |
6955 |
(and (featurep 'xemacs) |
(and (featurep 'xemacs) |
7086 |
"Specify if query is needed for process when Emacs is exited. |
"Specify if query is needed for process when Emacs is exited. |
7087 |
If the second argument flag is non-nil, Emacs will query the user before |
If the second argument flag is non-nil, Emacs will query the user before |
7088 |
exiting if process is running." |
exiting if process is running." |
7089 |
|
(funcall |
7090 |
(if (fboundp 'set-process-query-on-exit-flag) |
(if (fboundp 'set-process-query-on-exit-flag) |
7091 |
(set-process-query-on-exit-flag process flag) |
(symbol-function 'set-process-query-on-exit-flag) |
7092 |
(funcall (symbol-function 'process-kill-without-query) |
(symbol-function 'process-kill-without-query)) |
7093 |
process flag))) |
process flag)) |
7094 |
|
|
7095 |
|
|
7096 |
;; ------------------------------------------------------------ |
;; ------------------------------------------------------------ |
7170 |
;; CCC: This check is now also really awful; we should search all |
;; CCC: This check is now also really awful; we should search all |
7171 |
;; of the filename format, not just the prefix. |
;; of the filename format, not just the prefix. |
7172 |
(when (string-match "\\[" tramp-prefix-format) |
(when (string-match "\\[" tramp-prefix-format) |
7173 |
(defadvice file-expand-wildcards (around tramp-fix activate) |
(defadvice file-expand-wildcards (around tramp-fix activate) |
7174 |
(let ((name (ad-get-arg 0))) |
(let ((name (ad-get-arg 0))) |
7175 |
(if (tramp-tramp-file-p name) |
(if (tramp-tramp-file-p name) |
7176 |
;; If it's a Tramp file, dissect it and look if wildcards |
;; If it's a Tramp file, dissect it and look if wildcards |
7177 |
;; need to be expanded at all. |
;; need to be expanded at all. |
7178 |
(let ((v (tramp-dissect-file-name name))) |
(let ((v (tramp-dissect-file-name name))) |
7179 |
(if (string-match "[[*?]" (tramp-file-name-localname v)) |
(if (string-match "[[*?]" (tramp-file-name-localname v)) |
7180 |
(let ((res ad-do-it)) |
(let ((res ad-do-it)) |
7181 |
(setq ad-return-value (or res (list name)))) |
(setq ad-return-value (or res (list name)))) |
7182 |
(setq ad-return-value (list name)))) |
(setq ad-return-value (list name)))) |
7183 |
;; If it is not a Tramp file, just run the original function. |
;; If it is not a Tramp file, just run the original function. |
7184 |
(let ((res ad-do-it)) |
(let ((res ad-do-it)) |
7185 |
(setq ad-return-value (or res (list name))))))) |
(setq ad-return-value (or res (list name)))))))) |
|
) |
|
7186 |
|
|
7187 |
;; Tramp version is useful in a number of situations. |
;; Tramp version is useful in a number of situations. |
7188 |
|
|
7202 |
(interactive) |
(interactive) |
7203 |
(require 'reporter) |
(require 'reporter) |
7204 |
(catch 'dont-send |
(catch 'dont-send |
7205 |
(let ((reporter-prompt-for-summary-p t)) |
(let ((reporter-prompt-for-summary-p t)) |
7206 |
(reporter-submit-bug-report |
(reporter-submit-bug-report |
7207 |
tramp-bug-report-address ; to-address |
tramp-bug-report-address ; to-address |
7208 |
(format "tramp (%s)" tramp-version) ; package name and version |
(format "tramp (%s)" tramp-version) ; package name and version |
7209 |
`(;; Current state |
(delq nil |
7210 |
tramp-ls-command |
`(;; Current state |
7211 |
tramp-test-groks-nt |
tramp-ls-command |
7212 |
tramp-file-exists-command |
tramp-test-groks-nt |
7213 |
tramp-current-multi-method |
tramp-file-exists-command |
7214 |
tramp-current-method |
tramp-current-multi-method |
7215 |
tramp-current-user |
tramp-current-method |
7216 |
tramp-current-host |
tramp-current-user |
7217 |
|
tramp-current-host |
7218 |
;; System defaults |
|
7219 |
tramp-auto-save-directory ; vars to dump |
;; System defaults |
7220 |
tramp-default-method |
tramp-auto-save-directory ; vars to dump |
7221 |
tramp-rsh-end-of-line |
tramp-default-method |
7222 |
tramp-default-password-end-of-line |
tramp-rsh-end-of-line |
7223 |
tramp-remote-path |
tramp-default-password-end-of-line |
7224 |
tramp-login-prompt-regexp |
tramp-remote-path |
7225 |
tramp-password-prompt-regexp |
tramp-login-prompt-regexp |
7226 |
tramp-wrong-passwd-regexp |
;; Mask non-7bit characters |
7227 |
tramp-yesno-prompt-regexp |
(tramp-password-prompt-regexp . tramp-reporter-dump-variable) |
7228 |
tramp-yn-prompt-regexp |
tramp-wrong-passwd-regexp |
7229 |
tramp-terminal-prompt-regexp |
tramp-yesno-prompt-regexp |
7230 |
tramp-temp-name-prefix |
tramp-yn-prompt-regexp |
7231 |
tramp-file-name-structure |
tramp-terminal-prompt-regexp |
7232 |
tramp-file-name-regexp |
tramp-temp-name-prefix |
7233 |
tramp-multi-file-name-structure |
tramp-file-name-structure |
7234 |
tramp-multi-file-name-hop-structure |
tramp-file-name-regexp |
7235 |
tramp-multi-methods |
tramp-multi-file-name-structure |
7236 |
tramp-multi-connection-function-alist |
tramp-multi-file-name-hop-structure |
7237 |
tramp-methods |
tramp-multi-methods |
7238 |
tramp-end-of-output |
tramp-multi-connection-function-alist |
7239 |
tramp-coding-commands |
tramp-methods |
7240 |
tramp-actions-before-shell |
tramp-end-of-output |
7241 |
tramp-actions-copy-out-of-band |
tramp-coding-commands |
7242 |
tramp-multi-actions |
tramp-actions-before-shell |
7243 |
tramp-terminal-type |
tramp-actions-copy-out-of-band |
7244 |
tramp-shell-prompt-pattern |
tramp-multi-actions |
7245 |
tramp-chunksize |
tramp-terminal-type |
7246 |
,(when (boundp 'tramp-backup-directory-alist) |
;; Mask non-7bit characters |
7247 |
'tramp-backup-directory-alist) |
(tramp-shell-prompt-pattern . tramp-reporter-dump-variable) |
7248 |
,(when (boundp 'tramp-bkup-backup-directory-info) |
tramp-chunksize |
7249 |
'tramp-bkup-backup-directory-info) |
,(when (boundp 'tramp-backup-directory-alist) |
7250 |
|
'tramp-backup-directory-alist) |
7251 |
;; Non-tramp variables of interest |
,(when (boundp 'tramp-bkup-backup-directory-info) |
7252 |
shell-prompt-pattern |
'tramp-bkup-backup-directory-info) |
7253 |
backup-by-copying |
|
7254 |
backup-by-copying-when-linked |
;; Non-tramp variables of interest |
7255 |
backup-by-copying-when-mismatch |
;; Mask non-7bit characters |
7256 |
,(when (boundp 'backup-by-copying-when-privileged-mismatch) |
(shell-prompt-pattern . tramp-reporter-dump-variable) |
7257 |
'backup-by-copying-when-privileged-mismatch) |
backup-by-copying |
7258 |
,(when (boundp 'password-cache) |
backup-by-copying-when-linked |
7259 |
'password-cache) |
backup-by-copying-when-mismatch |
7260 |
,(when (boundp 'password-cache-expiry) |
,(when (boundp 'backup-by-copying-when-privileged-mismatch) |
7261 |
'password-cache-expiry) |
'backup-by-copying-when-privileged-mismatch) |
7262 |
,(when (boundp 'backup-directory-alist) |
,(when (boundp 'password-cache) |
7263 |
'backup-directory-alist) |
'password-cache) |
7264 |
,(when (boundp 'bkup-backup-directory-info) |
,(when (boundp 'password-cache-expiry) |
7265 |
'bkup-backup-directory-info) |
'password-cache-expiry) |
7266 |
file-name-handler-alist) |
,(when (boundp 'backup-directory-alist) |
7267 |
nil ; pre-hook |
'backup-directory-alist) |
7268 |
|
,(when (boundp 'bkup-backup-directory-info) |
7269 |
|
'bkup-backup-directory-info) |
7270 |
|
file-name-handler-alist)) |
7271 |
|
|
7272 |
|
'tramp-load-report-modules ; pre-hook |
7273 |
'tramp-append-tramp-buffers ; post-hook |
'tramp-append-tramp-buffers ; post-hook |
7274 |
"\ |
"\ |
7275 |
Enter your bug report in this message, including as much detail as you |
Enter your bug report in this message, including as much detail as you |
7288 |
--bug report follows this line-- |
--bug report follows this line-- |
7289 |
")))) |
")))) |
7290 |
|
|
7291 |
(defun tramp-append-tramp-buffers () |
(defun tramp-reporter-dump-variable (varsym mailbuf) |
7292 |
"Append Tramp buffers into the bug report." |
"Pretty-print the value of the variable in symbol VARSYM. |
7293 |
|
Used for non-7bit chars in strings." |
7294 |
|
(let* ((reporter-eval-buffer (symbol-value 'reporter-eval-buffer)) |
7295 |
|
(val (with-current-buffer reporter-eval-buffer |
7296 |
|
(symbol-value varsym)))) |
7297 |
|
|
7298 |
|
;; There are characters to be masked. |
7299 |
|
(when (and (boundp 'mm-7bit-chars) |
7300 |
|
(string-match |
7301 |
|
(concat "[^" (symbol-value 'mm-7bit-chars) "]") val)) |
7302 |
|
(with-current-buffer reporter-eval-buffer |
7303 |
|
(set varsym (concat "(base64-decode-string \"" |
7304 |
|
(base64-encode-string val) |
7305 |
|
"\")")))) |
7306 |
|
|
7307 |
|
;; Dump variable. |
7308 |
|
(funcall (symbol-function 'reporter-dump-variable) varsym mailbuf) |
7309 |
|
|
7310 |
|
;; Remove string quotation. |
7311 |
|
(forward-line -1) |
7312 |
|
(when (looking-at |
7313 |
|
(concat "\\(^.*\\)" "\"" ;; \1 " |
7314 |
|
"\\((base64-decode-string \\)" "\\\\" ;; \2 \ |
7315 |
|
"\\(\".*\\)" "\\\\" ;; \3 \ |
7316 |
|
"\\(\")\\)" "\"$")) ;; \4 " |
7317 |
|
(replace-match "\\1\\2\\3\\4") |
7318 |
|
(beginning-of-line) |
7319 |
|
(insert " ;; variable encoded due to non-printable characters\n")) |
7320 |
|
(forward-line 1) |
7321 |
|
|
7322 |
|
;; Reset VARSYM to old value. |
7323 |
|
(with-current-buffer reporter-eval-buffer |
7324 |
|
(set varsym val)))) |
7325 |
|
|
7326 |
|
(defun tramp-load-report-modules () |
7327 |
|
"Load needed modules for reporting." |
7328 |
|
|
7329 |
;; We load message.el and mml.el from Gnus. |
;; We load message.el and mml.el from Gnus. |
7330 |
(if (featurep 'xemacs) |
(if (featurep 'xemacs) |
7334 |
(require 'message nil 'noerror) |
(require 'message nil 'noerror) |
7335 |
(require 'mml nil 'noerror)) |
(require 'mml nil 'noerror)) |
7336 |
(when (functionp 'message-mode) |
(when (functionp 'message-mode) |
7337 |
(funcall 'message-mode)) |
(funcall (symbol-function 'message-mode))) |
7338 |
(when (functionp 'mml-mode) |
(when (functionp 'mml-mode) |
7339 |
(funcall 'mml-mode t)) |
(funcall (symbol-function 'mml-mode) t))) |
7340 |
|
|
7341 |
|
(defun tramp-append-tramp-buffers () |
7342 |
|
"Append Tramp buffers into the bug report." |
7343 |
|
|
7344 |
(when (and |
(when (and |
7345 |
(eq major-mode 'message-mode) |
(eq major-mode 'message-mode) |
7393 |
(goto-char (point-max)) |
(goto-char (point-max)) |
7394 |
(insert "\n\n") |
(insert "\n\n") |
7395 |
(dolist (buffer buffer-list) |
(dolist (buffer buffer-list) |
7396 |
(mml-insert-empty-tag |
(funcall (symbol-function 'mml-insert-empty-tag) |
7397 |
'part 'type "text/plain" 'encoding "base64" |
'part 'type "text/plain" 'encoding "base64" |
7398 |
'disposition "attachment" 'buffer (buffer-name buffer) |
'disposition "attachment" 'buffer (buffer-name buffer) |
7399 |
'description (buffer-name buffer))) |
'description (buffer-name buffer))) |
7400 |
(set-buffer-modified-p nil)) |
(set-buffer-modified-p nil)) |
7401 |
|
|
7402 |
;; Don't send. Delete the message buffer. |
;; Don't send. Delete the message buffer. |