aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMichael Albinus2012-06-11 12:30:07 +0200
committerMichael Albinus2012-06-11 12:30:07 +0200
commit2fe4b1254dc0673e161e7aee6ef6f983af86289b (patch)
tree5e93be19d0d9be8fa085d528c03f9b780ce35f34
parent72834e10a691114e39a9ad3d3abe93ae9ae83d11 (diff)
downloademacs-2fe4b1254dc0673e161e7aee6ef6f983af86289b.tar.gz
emacs-2fe4b1254dc0673e161e7aee6ef6f983af86289b.zip
Sync with Tramp 2.2.6-pre.
* net/tramp-cache.el (tramp-dump-connection-properties): Let-bind `print-length' and `print-level' to nil, in order to avoid truncation. Reported by Christopher Schmidt <christopher@ristopher.com>. * net/tramp-cmds.el (tramp-cleanup-connection): Delete also process. * net/tramp-compat.el (tramp-compat-condition-case-unless-debug): New defmacro. (tramp-compat-copy-directory): Add optional argument COPY-CONTENTS. It is not handled yet. * net/tramp-ftp.el (tramp-disable-ange-ftp): Fix docstring. (tramp-ftp-file-name-p): Simplify. * net/tramp-gvfs.el (tramp-gvfs-handle-expand-file-name): * net/tramp-gw.el (tramp-gw-open-connection): Add hop to connection vector. * net/tramp-sh.el (tramp-copy-size-limit): Fix docstring. (tramp-methods): Do not use `tramp-password-end-of-line'. (tramp-completion-function-alist-putty): Handle UNIX case. (tramp-remote-path): Add "/opt/bin", "/opt/sbin" and "/opt/local/bin". (tramp-do-file-attributes-with-stat) (tramp-do-directory-files-and-attributes-with-stat) Return uid and gid as real numbers. They could run out of integer range on cygwin. (tramp-do-copy-or-rename-file-out-of-band): Better trace format. (tramp-sh-handle-expand-file-name): Handle hops. (tramp-open-connection-setup-interactive-shell): Use `tramp-cleanup'. Move check for busyboxes ... (tramp-find-shell): ... here. Simplify implementation. Set "remote-shell" property also for alternative shells. (tramp-remote-coding-commands): Check "test -c /dev/stdout". If failing, a regular file would be written otherwise. Reported by Dmitry Kurochkin <dmitry.kurochkin@gmail.com>. (tramp-find-inline-encoding): Cache the coding commands in the process cache. Apply test command on the remote side, if defined. (tramp-find-inline-compress): Cache the compress commands in the process cache. (tramp-compute-multi-hops): Save `tramp-default-proxies-alist' when requested. Handle hops. (tramp-current-connection): New defvar. (tramp-maybe-open-connection): Use `tramp-cleanup'. Throw `suppress', if there was a failed connection shortly before. Handle user interrupt. (Bug#10187) (tramp-get-inline-compress, tramp-get-inline-coding): Read connection properties from the process cache. * net/tramp-smb.el (tramp-smb-server-version) (tramp-smb-wrong-passwd-regexp, tramp-smb-actions-with-tar): New defconsts. (tramp-smb-prompt): Extend for powershell prompt. (tramp-smb-file-name-handler-alist): Add handlers for `process-file', `shell-command' and `start-file-process'. (tramp-smb-winexe-program, tramp-smb-winexe-shell-command) (tramp-smb-winexe-shell-command-switch): New defcustoms. (tramp-smb-file-name-p): Simplify. (tramp-smb-action-with-tar, tramp-smb-handle-process-file) (tramp-smb-kill-winexe-function, tramp-smb-call-winexe) (tramp-smb-shell-quote-argument): New defuns. (tramp-smb-handle-copy-directory): Add COPY-CONTENTS argument. Implement using "tar". By this, time-stamps are preserved. (tramp-smb-handle-copy-file): Handle also the case of directories. (tramp-smb-do-file-attributes-with-stat) (tramp-smb-get-file-entries, tramp-smb-get-cifs-capabilities): Use `tramp-get-connection-buffer'). (tramp-smb-handle-rename-file): Use "rename", when source and target are on the same share. (tramp-smb-maybe-open-connection): Handle wrong passwords. Use `tramp-smb-server-version'. (tramp-smb-wait-for-output): Remove prompt. * net/tramp.el (top): Require 'cl. (tramp-methods, tramp-rsh-end-of-line): Remove `tramp-password-end-of-line' from docstring. (tramp-save-ad-hoc-proxies): New defcustom. (tramp-completion-function-alist): Adapt docstring. (tramp-default-password-end-of-line): Remove defcustom. (tramp-shell-prompt-pattern): Allow "[]" style prompts. (Bug#11065) (tramp-user-regexp, tramp-file-name-regexp-unified) (tramp-file-name-regexp-url): Extend regexp by hop separator. (tramp-postfix-hop-format, tramp-postfix-hop-regexp) (tramp-remote-file-name-spec-regexp): New defconst. (tramp-file-name-structure): Extend structure for hops. (tramp-get-method-parameter): Move up. (tramp-file-name-p, tramp-dissect-file-name) (with-parsed-tramp-file-name): Handle hops. (tramp-file-name-hop): New defun. (tramp-make-tramp-file-name): New optional arg HOP. (tramp-message-show-progress-reporter-message): New defvar. (tramp-with-progress-reporter): Use it. We cannot use `tramp-message-show-message' here, because this suppresses also error buffers. (tramp-error-with-buffer): Suppress buffer view, if `tramp-message-show-message' is nil. Use `tramp-get-connection-buffer'. (tramp-cleanup): New defun. (tramp-rfn-eshadow-update-overlay): Let-bind `non-essential' to `t'. (tramp-file-name-handler): If `debug-on-error' is set, propagate an error unchanged. (tramp-completion-handle-file-name-all-completions): Handle hops. Fix an error when called from ido. (tramp-completion-dissect-file-name): Use better local variable name. Add hop to the vector. (tramp-handle-insert-file-contents): Use progress-reporter for the whole scenario. (tramp-action-password): Let-bind `enable-recursive-minibuffers' to `t'. (tramp-check-for-regexp): Simplify search. (tramp-enter-password): Remove it. Move implementation ... (tramp-action-password): ... here. (tramp-mode-string-to-int, tramp-local-host-p) (tramp-make-tramp-temp-file, tramp-read-passwd) (tramp-clear-passwd, tramp-time-less-p, tramp-time-diff): Set tramp-autoload cookie. * net/trampver.el: Update release number. * net/tramp.el (tramp-set-completion-function): Fix docstring. (tramp-parse-group, tramp-parse-file) (tramp-parse-shostkeys-sknownhosts): New defuns. (tramp-parse-rhosts, tramp-parse-rhosts-group, tramp-parse-shosts) (tramp-parse-shosts-group, tramp-parse-sconfig) (tramp-parse-sconfig-group, tramp-parse-shostkeys) (tramp-parse-sknownhosts, tramp-parse-hosts) (tramp-parse-hosts-group, tramp-parse-passwd, tramp-parse-netrc): Use them. (tramp-parse-passwd-group, tramp-parse-netrc-group) (tramp-parse-putty-group): Don't narrow. (tramp-parse-putty): Make a loop. (tramp-file-name-handler): Catch the `suppress' signal.
-rw-r--r--lisp/ChangeLog145
-rw-r--r--lisp/net/tramp-cache.el3
-rw-r--r--lisp/net/tramp-cmds.el4
-rw-r--r--lisp/net/tramp-compat.el94
-rw-r--r--lisp/net/tramp-ftp.el9
-rw-r--r--lisp/net/tramp-gvfs.el2
-rw-r--r--lisp/net/tramp-gw.el2
-rw-r--r--lisp/net/tramp-sh.el264
-rw-r--r--lisp/net/tramp-smb.el689
-rw-r--r--lisp/net/tramp.el681
-rw-r--r--lisp/net/trampver.el4
11 files changed, 1230 insertions, 667 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 6872e3d2235..198e9c5e602 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,142 @@
12012-06-11 Michael Albinus <michael.albinus@gmx.de>
2
3 Sync with Tramp 2.2.6-pre.
4
5 * net/tramp-cache.el (tramp-dump-connection-properties): Let-bind
6 `print-length' and `print-level' to nil, in order to avoid
7 truncation. Reported by Christopher Schmidt
8 <christopher@ristopher.com>.
9
10 * net/tramp-cmds.el (tramp-cleanup-connection): Delete also process.
11
12 * net/tramp-compat.el (tramp-compat-condition-case-unless-debug):
13 New defmacro.
14 (tramp-compat-copy-directory): Add optional argument
15 COPY-CONTENTS. It is not handled yet.
16
17 * net/tramp-ftp.el (tramp-disable-ange-ftp): Fix docstring.
18 (tramp-ftp-file-name-p): Simplify.
19
20 * net/tramp-gvfs.el (tramp-gvfs-handle-expand-file-name):
21 * net/tramp-gw.el (tramp-gw-open-connection): Add hop to
22 connection vector.
23
24 * net/tramp-sh.el (tramp-copy-size-limit): Fix docstring.
25 (tramp-methods): Do not use `tramp-password-end-of-line'.
26 (tramp-completion-function-alist-putty): Handle UNIX case.
27 (tramp-remote-path): Add "/opt/bin", "/opt/sbin" and "/opt/local/bin".
28 (tramp-do-file-attributes-with-stat)
29 (tramp-do-directory-files-and-attributes-with-stat) Return uid and
30 gid as real numbers. They could run out of integer range on cygwin.
31 (tramp-do-copy-or-rename-file-out-of-band): Better trace format.
32 (tramp-sh-handle-expand-file-name): Handle hops.
33 (tramp-open-connection-setup-interactive-shell): Use
34 `tramp-cleanup'. Move check for busyboxes ...
35 (tramp-find-shell): ... here. Simplify implementation. Set
36 "remote-shell" property also for alternative shells.
37 (tramp-remote-coding-commands): Check "test -c /dev/stdout". If
38 failing, a regular file would be written otherwise. Reported by
39 Dmitry Kurochkin <dmitry.kurochkin@gmail.com>.
40 (tramp-find-inline-encoding): Cache the coding commands in the
41 process cache. Apply test command on the remote side, if defined.
42 (tramp-find-inline-compress): Cache the compress commands in the
43 process cache.
44 (tramp-compute-multi-hops): Save `tramp-default-proxies-alist'
45 when requested. Handle hops.
46 (tramp-current-connection): New defvar.
47 (tramp-maybe-open-connection): Use `tramp-cleanup'. Throw
48 `suppress', if there was a failed connection shortly before.
49 Handle user interrupt. (Bug#10187)
50 (tramp-get-inline-compress, tramp-get-inline-coding): Read
51 connection properties from the process cache.
52
53 * net/tramp-smb.el (tramp-smb-server-version)
54 (tramp-smb-wrong-passwd-regexp, tramp-smb-actions-with-tar): New
55 defconsts.
56 (tramp-smb-prompt): Extend for powershell prompt.
57 (tramp-smb-file-name-handler-alist): Add handlers for
58 `process-file', `shell-command' and `start-file-process'.
59 (tramp-smb-winexe-program, tramp-smb-winexe-shell-command)
60 (tramp-smb-winexe-shell-command-switch): New defcustoms.
61 (tramp-smb-file-name-p): Simplify.
62 (tramp-smb-action-with-tar, tramp-smb-handle-process-file)
63 (tramp-smb-kill-winexe-function, tramp-smb-call-winexe)
64 (tramp-smb-shell-quote-argument): New defuns.
65 (tramp-smb-handle-copy-directory): Add COPY-CONTENTS argument.
66 Implement using "tar". By this, time-stamps are preserved.
67 (tramp-smb-handle-copy-file): Handle also the case of directories.
68 (tramp-smb-do-file-attributes-with-stat)
69 (tramp-smb-get-file-entries, tramp-smb-get-cifs-capabilities): Use
70 `tramp-get-connection-buffer').
71 (tramp-smb-handle-rename-file): Use "rename", when source and
72 target are on the same share.
73 (tramp-smb-maybe-open-connection): Handle wrong passwords. Use
74 `tramp-smb-server-version'.
75 (tramp-smb-wait-for-output): Remove prompt.
76
77 * net/tramp.el (top): Require 'cl.
78 (tramp-methods, tramp-rsh-end-of-line): Remove
79 `tramp-password-end-of-line' from docstring.
80 (tramp-save-ad-hoc-proxies): New defcustom.
81 (tramp-completion-function-alist): Adapt docstring.
82 (tramp-default-password-end-of-line): Remove defcustom.
83 (tramp-shell-prompt-pattern): Allow "[]" style prompts. (Bug#11065)
84 (tramp-user-regexp, tramp-file-name-regexp-unified)
85 (tramp-file-name-regexp-url): Extend regexp by hop separator.
86 (tramp-postfix-hop-format, tramp-postfix-hop-regexp)
87 (tramp-remote-file-name-spec-regexp): New defconst.
88 (tramp-file-name-structure): Extend structure for hops.
89 (tramp-get-method-parameter): Move up.
90 (tramp-file-name-p, tramp-dissect-file-name)
91 (with-parsed-tramp-file-name): Handle hops.
92 (tramp-file-name-hop): New defun.
93 (tramp-make-tramp-file-name): New optional arg HOP.
94 (tramp-message-show-progress-reporter-message): New defvar.
95 (tramp-with-progress-reporter): Use it. We cannot use
96 `tramp-message-show-message' here, because this suppresses also
97 error buffers.
98 (tramp-error-with-buffer): Suppress buffer view, if
99 `tramp-message-show-message' is nil. Use
100 `tramp-get-connection-buffer'.
101 (tramp-cleanup): New defun.
102 (tramp-rfn-eshadow-update-overlay): Let-bind `non-essential' to `t'.
103 (tramp-file-name-handler): If `debug-on-error' is set, propagate
104 an error unchanged.
105 (tramp-completion-handle-file-name-all-completions): Handle hops.
106 Fix an error when called from ido.
107 (tramp-completion-dissect-file-name): Use better local variable
108 name. Add hop to the vector.
109 (tramp-handle-insert-file-contents): Use progress-reporter for the
110 whole scenario.
111 (tramp-action-password): Let-bind `enable-recursive-minibuffers'
112 to `t'.
113 (tramp-check-for-regexp): Simplify search.
114 (tramp-enter-password): Remove it. Move implementation ...
115 (tramp-action-password): ... here.
116 (tramp-mode-string-to-int, tramp-local-host-p)
117 (tramp-make-tramp-temp-file, tramp-read-passwd)
118 (tramp-clear-passwd, tramp-time-less-p, tramp-time-diff): Set
119 tramp-autoload cookie.
120
121 * net/trampver.el: Update release number.
122
1232012-06-11 Thierry Volpiatto <thierry.volpiatto@gmail.com>
124 Michael Albinus <michael.albinus@gmx.de>
125
126 * net/tramp.el (tramp-set-completion-function): Fix docstring.
127 (tramp-parse-group, tramp-parse-file)
128 (tramp-parse-shostkeys-sknownhosts): New defuns.
129 (tramp-parse-rhosts, tramp-parse-rhosts-group, tramp-parse-shosts)
130 (tramp-parse-shosts-group, tramp-parse-sconfig)
131 (tramp-parse-sconfig-group, tramp-parse-shostkeys)
132 (tramp-parse-sknownhosts, tramp-parse-hosts)
133 (tramp-parse-hosts-group, tramp-parse-passwd, tramp-parse-netrc):
134 Use them.
135 (tramp-parse-passwd-group, tramp-parse-netrc-group)
136 (tramp-parse-putty-group): Don't narrow.
137 (tramp-parse-putty): Make a loop.
138 (tramp-file-name-handler): Catch the `suppress' signal.
139
12012-06-11 Chong Yidong <cyd@gnu.org> 1402012-06-11 Chong Yidong <cyd@gnu.org>
2 141
3 * image.el (imagemagick-register-types): Put the ImageMagick entry 142 * image.el (imagemagick-register-types): Put the ImageMagick entry
@@ -4884,9 +5023,6 @@
4884 5023
4885 * net/tramp.el (tramp-action-login): Set connection property "login-as". 5024 * net/tramp.el (tramp-action-login): Set connection property "login-as".
4886 5025
4887 * net/tramp-cache.el (tramp-dump-connection-properties): Do not dump
4888 properties, when "login-as" is set.
4889
4890 * net/tramp-sh.el (tramp-methods): Add user spec to "pscp" and "psftp". 5026 * net/tramp-sh.el (tramp-methods): Add user spec to "pscp" and "psftp".
4891 (tramp-default-user-alist): Don't add "pscp". 5027 (tramp-default-user-alist): Don't add "pscp".
4892 (tramp-do-copy-or-rename-file-out-of-band): Use connection 5028 (tramp-do-copy-or-rename-file-out-of-band): Use connection
@@ -6211,9 +6347,6 @@
6211 6347
62122011-11-16 Michael Albinus <michael.albinus@gmx.de> 63482011-11-16 Michael Albinus <michael.albinus@gmx.de>
6213 6349
6214 * net/tramp-cache.el (tramp-flush-file-property): Flush also
6215 properties of linked files. (Bug#9879)
6216
6217 * net/tramp-sh.el (tramp-sh-handle-file-truename): Cache only the 6350 * net/tramp-sh.el (tramp-sh-handle-file-truename): Cache only the
6218 local file name. 6351 local file name.
6219 6352
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index d222dd1011d..fe5eb0049d0 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -328,7 +328,8 @@ KEY identifies the connection, it is either a process or a vector."
328 (not (zerop (hash-table-count tramp-cache-data))) 328 (not (zerop (hash-table-count tramp-cache-data)))
329 tramp-cache-data-changed 329 tramp-cache-data-changed
330 (stringp tramp-persistency-file-name)) 330 (stringp tramp-persistency-file-name))
331 (let ((cache (copy-hash-table tramp-cache-data))) 331 (let ((cache (copy-hash-table tramp-cache-data))
332 print-length print-level)
332 ;; Remove temporary data. If there is the key "login-as", we 333 ;; Remove temporary data. If there is the key "login-as", we
333 ;; don't save either, because all other properties might 334 ;; don't save either, because all other properties might
334 ;; depend on the login name, and we want to give the 335 ;; depend on the login name, and we want to give the
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index e0d15eb85f6..042e51d5c9e 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -89,7 +89,9 @@ When called interactively, a Tramp connection has to be selected."
89 (tramp-flush-directory-property vec "") 89 (tramp-flush-directory-property vec "")
90 90
91 ;; Flush connection cache. 91 ;; Flush connection cache.
92 (tramp-flush-connection-property (tramp-get-connection-process vec)) 92 (when (processp (tramp-get-connection-process vec))
93 (delete-process (tramp-get-connection-process vec))
94 (tramp-flush-connection-property (tramp-get-connection-process vec)))
93 (tramp-flush-connection-property vec) 95 (tramp-flush-connection-property vec)
94 96
95 ;; Remove buffers. 97 ;; Remove buffers.
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 5ae987f0822..9984195627c 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -194,6 +194,22 @@
194 "Display MESSAGE temporarily if non-nil while BODY is evaluated." 194 "Display MESSAGE temporarily if non-nil while BODY is evaluated."
195 `(progn ,@body))) 195 `(progn ,@body)))
196 196
197;; `condition-case-unless-debug' is introduced with Emacs 24.
198(if (fboundp 'condition-case-unless-debug)
199 (defalias 'tramp-compat-condition-case-unless-debug
200 'condition-case-unless-debug)
201 (defmacro tramp-compat-condition-case-unless-debug
202 (var bodyform &rest handlers)
203 "Like `condition-case' except that it does not catch anything when debugging."
204 (declare (debug condition-case) (indent 2))
205 (let ((bodysym (make-symbol "body")))
206 `(let ((,bodysym (lambda () ,bodyform)))
207 (if debug-on-error
208 (funcall ,bodysym)
209 (condition-case ,var
210 (funcall ,bodysym)
211 ,@handlers))))))
212
197;; `font-lock-add-keywords' does not exist in XEmacs. 213;; `font-lock-add-keywords' does not exist in XEmacs.
198(defun tramp-compat-font-lock-add-keywords (mode keywords &optional how) 214(defun tramp-compat-font-lock-add-keywords (mode keywords &optional how)
199 "Add highlighting KEYWORDS for MODE." 215 "Add highlighting KEYWORDS for MODE."
@@ -312,43 +328,49 @@ Not actually used. Use `(format \"%o\" i)' instead?"
312;; `copy-directory' is a new function in Emacs 23.2. Implementation 328;; `copy-directory' is a new function in Emacs 23.2. Implementation
313;; is taken from there. 329;; is taken from there.
314(defun tramp-compat-copy-directory 330(defun tramp-compat-copy-directory
315 (directory newname &optional keep-time parents) 331 (directory newname &optional keep-time parents copy-contents)
316 "Make a copy of DIRECTORY (compat function)." 332 "Make a copy of DIRECTORY (compat function)."
317 (if (fboundp 'copy-directory) 333 (condition-case nil
318 (tramp-compat-funcall 'copy-directory directory newname keep-time parents) 334 (tramp-compat-funcall
319 335 'copy-directory directory newname keep-time parents copy-contents)
320 ;; If `default-directory' is a remote directory, make sure we find 336
321 ;; its `copy-directory' handler. 337 ;; `copy-directory' is either not implemented, or it does not
322 (let ((handler (or (find-file-name-handler directory 'copy-directory) 338 ;; support the the COPY-CONTENTS flag. For the time being, we
323 (find-file-name-handler newname 'copy-directory)))) 339 ;; ignore COPY-CONTENTS as well.
324 (if handler 340
325 (funcall handler 'copy-directory directory newname keep-time parents) 341 (error
326 342 ;; If `default-directory' is a remote directory, make sure we
327 ;; Compute target name. 343 ;; find its `copy-directory' handler.
328 (setq directory (directory-file-name (expand-file-name directory)) 344 (let ((handler (or (find-file-name-handler directory 'copy-directory)
329 newname (directory-file-name (expand-file-name newname))) 345 (find-file-name-handler newname 'copy-directory))))
330 (if (and (file-directory-p newname) 346 (if handler
331 (not (string-equal (file-name-nondirectory directory) 347 (funcall handler 'copy-directory directory newname keep-time parents)
332 (file-name-nondirectory newname)))) 348
333 (setq newname 349 ;; Compute target name.
334 (expand-file-name 350 (setq directory (directory-file-name (expand-file-name directory))
335 (file-name-nondirectory directory) newname))) 351 newname (directory-file-name (expand-file-name newname)))
336 (if (not (file-directory-p newname)) (make-directory newname parents)) 352 (if (and (file-directory-p newname)
337 353 (not (string-equal (file-name-nondirectory directory)
338 ;; Copy recursively. 354 (file-name-nondirectory newname))))
339 (mapc 355 (setq newname
340 (lambda (file) 356 (expand-file-name
341 (if (file-directory-p file) 357 (file-name-nondirectory directory) newname)))
342 (tramp-compat-copy-directory file newname keep-time parents) 358 (if (not (file-directory-p newname)) (make-directory newname parents))
343 (copy-file file newname t keep-time))) 359
344 ;; We do not want to delete "." and "..". 360 ;; Copy recursively.
345 (directory-files 361 (mapc
346 directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")) 362 (lambda (file)
347 363 (if (file-directory-p file)
348 ;; Set directory attributes. 364 (tramp-compat-copy-directory file newname keep-time parents)
349 (set-file-modes newname (file-modes directory)) 365 (copy-file file newname t keep-time)))
350 (if keep-time 366 ;; We do not want to delete "." and "..".
351 (set-file-times newname (nth 5 (file-attributes directory)))))))) 367 (directory-files
368 directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
369
370 ;; Set directory attributes.
371 (set-file-modes newname (file-modes directory))
372 (if keep-time
373 (set-file-times newname (nth 5 (file-attributes directory)))))))))
352 374
353;; TRASH has been introduced with Emacs 24.1. 375;; TRASH has been introduced with Emacs 24.1.
354(defun tramp-compat-delete-file (filename &optional trash) 376(defun tramp-compat-delete-file (filename &optional trash)
diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el
index 73bc6878115..44ae176c6c9 100644
--- a/lisp/net/tramp-ftp.el
+++ b/lisp/net/tramp-ftp.el
@@ -49,9 +49,8 @@
49(defun tramp-disable-ange-ftp () 49(defun tramp-disable-ange-ftp ()
50 "Turn Ange-FTP off. 50 "Turn Ange-FTP off.
51This is useful for unified remoting. See 51This is useful for unified remoting. See
52`tramp-file-name-structure-unified' and 52`tramp-file-name-structure' for details. Requests suitable for
53`tramp-file-name-structure-separate' for details. Requests suitable 53Ange-FTP will be forwarded to Ange-FTP. Also see the variables
54for Ange-FTP will be forwarded to Ange-FTP. Also see the variables
55`tramp-ftp-method', `tramp-default-method', and 54`tramp-ftp-method', `tramp-default-method', and
56`tramp-default-method-alist'. 55`tramp-default-method-alist'.
57 56
@@ -204,8 +203,8 @@ pass to the OPERATION."
204;;;###tramp-autoload 203;;;###tramp-autoload
205(defsubst tramp-ftp-file-name-p (filename) 204(defsubst tramp-ftp-file-name-p (filename)
206 "Check if it's a filename that should be forwarded to Ange-FTP." 205 "Check if it's a filename that should be forwarded to Ange-FTP."
207 (let ((v (tramp-dissect-file-name filename))) 206 (string= (tramp-file-name-method (tramp-dissect-file-name filename))
208 (string= (tramp-file-name-method v) tramp-ftp-method))) 207 tramp-ftp-method))
209 208
210;;;###tramp-autoload 209;;;###tramp-autoload
211(unless (featurep 'xemacs) 210(unless (featurep 'xemacs)
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 983b29dcb5e..b7a68465f94 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -625,7 +625,7 @@ is no information where to trace the message.")
625 ;; If there is a default location, expand tilde. 625 ;; If there is a default location, expand tilde.
626 (when (string-match "\\`\\(~\\)\\(/\\|\\'\\)" localname) 626 (when (string-match "\\`\\(~\\)\\(/\\|\\'\\)" localname)
627 (save-match-data 627 (save-match-data
628 (tramp-gvfs-maybe-open-connection (vector method user host "/"))) 628 (tramp-gvfs-maybe-open-connection (vector method user host "/" hop)))
629 (setq localname 629 (setq localname
630 (replace-match 630 (replace-match
631 (tramp-get-file-property v "/" "default-location" "~") 631 (tramp-get-file-property v "/" "default-location" "~")
diff --git a/lisp/net/tramp-gw.el b/lisp/net/tramp-gw.el
index 328d094dfa4..3aa25e2caa6 100644
--- a/lisp/net/tramp-gw.el
+++ b/lisp/net/tramp-gw.el
@@ -154,7 +154,7 @@ instead of the host name declared in TARGET-VEC."
154 (memq (process-status tramp-gw-aux-proc) '(listen))) 154 (memq (process-status tramp-gw-aux-proc) '(listen)))
155 (let ((aux-vec 155 (let ((aux-vec
156 (vector "aux" (tramp-file-name-user gw-vec) 156 (vector "aux" (tramp-file-name-user gw-vec)
157 (tramp-file-name-host gw-vec) nil))) 157 (tramp-file-name-host gw-vec) nil nil)))
158 (setq tramp-gw-aux-proc 158 (setq tramp-gw-aux-proc
159 (make-network-process 159 (make-network-process
160 :name (tramp-buffer-name aux-vec) :buffer nil :host 'local 160 :name (tramp-buffer-name aux-vec) :buffer nil :host 'local
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 9ccf1d8e3e2..47aaa4a8e57 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -51,8 +51,9 @@ If it is nil, no compression at all will be applied."
51 :type '(choice (const nil) integer)) 51 :type '(choice (const nil) integer))
52 52
53(defcustom tramp-copy-size-limit 10240 53(defcustom tramp-copy-size-limit 10240
54 "The maximum file size where inline copying is preferred over an out-of-the-band copy. 54 "The maximum file size where inline copying is preferred over an \
55If it is nil, inline out-of-the-band copy will be used without a check." 55out-of-the-band copy.
56If it is nil, out-of-the-band copy will be used without a check."
56 :group 'tramp 57 :group 'tramp
57 :type '(choice (const nil) integer)) 58 :type '(choice (const nil) integer))
58 59
@@ -347,7 +348,6 @@ detected as prompt when being sent on echoing hosts, therefore.")
347 (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%h"))) 348 (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%h")))
348 (tramp-remote-shell "/bin/sh") 349 (tramp-remote-shell "/bin/sh")
349 (tramp-remote-shell-args ("-c")) 350 (tramp-remote-shell-args ("-c"))
350 (tramp-password-end-of-line "xy") ;see docstring for "xy"
351 (tramp-default-port 22))) 351 (tramp-default-port 22)))
352;;;###tramp-autoload 352;;;###tramp-autoload
353(add-to-list 'tramp-methods 353(add-to-list 'tramp-methods
@@ -356,7 +356,6 @@ detected as prompt when being sent on echoing hosts, therefore.")
356 (tramp-login-args (("-l" "%u") ("-P" "%p") ("-1" "-ssh") ("%h"))) 356 (tramp-login-args (("-l" "%u") ("-P" "%p") ("-1" "-ssh") ("%h")))
357 (tramp-remote-shell "/bin/sh") 357 (tramp-remote-shell "/bin/sh")
358 (tramp-remote-shell-args ("-c")) 358 (tramp-remote-shell-args ("-c"))
359 (tramp-password-end-of-line "xy") ;see docstring for "xy"
360 (tramp-default-port 22))) 359 (tramp-default-port 22)))
361;;;###tramp-autoload 360;;;###tramp-autoload
362(add-to-list 'tramp-methods 361(add-to-list 'tramp-methods
@@ -384,7 +383,6 @@ detected as prompt when being sent on echoing hosts, therefore.")
384 ("-q") ("-r"))) 383 ("-q") ("-r")))
385 (tramp-copy-keep-date t) 384 (tramp-copy-keep-date t)
386 (tramp-copy-recursive t) 385 (tramp-copy-recursive t)
387 (tramp-password-end-of-line "xy") ;see docstring for "xy"
388 (tramp-default-port 22))) 386 (tramp-default-port 22)))
389;;;###tramp-autoload 387;;;###tramp-autoload
390(add-to-list 'tramp-methods 388(add-to-list 'tramp-methods
@@ -397,8 +395,7 @@ detected as prompt when being sent on echoing hosts, therefore.")
397 (tramp-copy-args (("-l" "%u") ("-P" "%p") ("-sftp") ("-p" "%k") 395 (tramp-copy-args (("-l" "%u") ("-P" "%p") ("-sftp") ("-p" "%k")
398 ("-q") ("-r"))) 396 ("-q") ("-r")))
399 (tramp-copy-keep-date t) 397 (tramp-copy-keep-date t)
400 (tramp-copy-recursive t) 398 (tramp-copy-recursive t)))
401 (tramp-password-end-of-line "xy"))) ;see docstring for "xy"
402;;;###tramp-autoload 399;;;###tramp-autoload
403(add-to-list 'tramp-methods 400(add-to-list 'tramp-methods
404 '("fcp" 401 '("fcp"
@@ -462,9 +459,11 @@ detected as prompt when being sent on echoing hosts, therefore.")
462 459
463;;;###tramp-autoload 460;;;###tramp-autoload
464(defconst tramp-completion-function-alist-putty 461(defconst tramp-completion-function-alist-putty
465 '((tramp-parse-putty 462 `((tramp-parse-putty
466 "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions")) 463 ,(if (memq system-type '(windows-nt))
467 "Default list of (FUNCTION REGISTRY) pairs to be examined for putty methods.") 464 "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions"
465 "~/.putty/sessions")))
466 "Default list of (FUNCTION REGISTRY) pairs to be examined for putty sessions.")
468 467
469;;;###tramp-autoload 468;;;###tramp-autoload
470(eval-after-load 'tramp 469(eval-after-load 'tramp
@@ -513,9 +512,10 @@ detected as prompt when being sent on echoing hosts, therefore.")
513;; IRIX64: /usr/bin 512;; IRIX64: /usr/bin
514;;;###tramp-autoload 513;;;###tramp-autoload
515(defcustom tramp-remote-path 514(defcustom tramp-remote-path
516 '(tramp-default-remote-path "/bin" "/usr/bin" "/usr/sbin" "/usr/local/bin" 515 '(tramp-default-remote-path "/bin" "/usr/bin" "/usr/sbin"
517 "/local/bin" "/local/freeware/bin" "/local/gnu/bin" 516 "/usr/local/bin" "/local/bin" "/local/freeware/bin" "/local/gnu/bin"
518 "/usr/freeware/bin" "/usr/pkg/bin" "/usr/contrib/bin") 517 "/usr/freeware/bin" "/usr/pkg/bin" "/usr/contrib/bin"
518 "/opt/bin" "/opt/sbin" "/opt/local/bin")
519 "List of directories to search for executables on remote host. 519 "List of directories to search for executables on remote host.
520For every remote host, this variable will be set buffer local, 520For every remote host, this variable will be set buffer local,
521keeping the list of existing directories on that host. 521keeping the list of existing directories on that host.
@@ -545,7 +545,6 @@ as given in your `~/.profile'."
545 ,(format "INSIDE_EMACS='%s,tramp:%s'" emacs-version tramp-version) 545 ,(format "INSIDE_EMACS='%s,tramp:%s'" emacs-version tramp-version)
546 "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH=" "PAGER=\"\"" 546 "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH=" "PAGER=\"\""
547 "autocorrect=" "correct=") 547 "autocorrect=" "correct=")
548
549 "List of environment variables to be set on the remote host. 548 "List of environment variables to be set on the remote host.
550 549
551Each element should be a string of the form ENVVARNAME=VALUE. An 550Each element should be a string of the form ENVVARNAME=VALUE. An
@@ -1180,9 +1179,6 @@ target of the symlink differ."
1180 (tramp-get-file-exists-command v) 1179 (tramp-get-file-exists-command v)
1181 (tramp-shell-quote-argument localname))))))) 1180 (tramp-shell-quote-argument localname)))))))
1182 1181
1183;; CCC: This should check for an error condition and signal failure
1184;; when something goes wrong.
1185;; Daniel Pittman <daniel@danann.net>
1186(defun tramp-sh-handle-file-attributes (filename &optional id-format) 1182(defun tramp-sh-handle-file-attributes (filename &optional id-format)
1187 "Like `file-attributes' for Tramp files." 1183 "Like `file-attributes' for Tramp files."
1188 (unless id-format (setq id-format 'integer)) 1184 (unless id-format (setq id-format 'integer))
@@ -1318,8 +1314,8 @@ target of the symlink differ."
1318 (tramp-get-test-command vec) 1314 (tramp-get-test-command vec)
1319 (tramp-shell-quote-argument localname) 1315 (tramp-shell-quote-argument localname)
1320 (tramp-get-remote-stat vec) 1316 (tramp-get-remote-stat vec)
1321 (if (eq id-format 'integer) "%u" "\"%U\"") 1317 (if (eq id-format 'integer) "%ue0" "\"%U\"")
1322 (if (eq id-format 'integer) "%g" "\"%G\"") 1318 (if (eq id-format 'integer) "%ge0" "\"%G\"")
1323 (tramp-shell-quote-argument localname)))) 1319 (tramp-shell-quote-argument localname))))
1324 1320
1325(defun tramp-sh-handle-set-visited-file-modtime (&optional time-list) 1321(defun tramp-sh-handle-set-visited-file-modtime (&optional time-list)
@@ -1702,8 +1698,8 @@ and gid of the corresponding user is taken. Both parameters must be integers."
1702 (tramp-shell-quote-argument localname) 1698 (tramp-shell-quote-argument localname)
1703 (tramp-get-ls-command vec) 1699 (tramp-get-ls-command vec)
1704 (tramp-get-remote-stat vec) 1700 (tramp-get-remote-stat vec)
1705 (if (eq id-format 'integer) "%u" "\"%U\"") 1701 (if (eq id-format 'integer) "%ue0" "\"%U\"")
1706 (if (eq id-format 'integer) "%g" "\"%G\"")))) 1702 (if (eq id-format 'integer) "%ge0" "\"%G\""))))
1707 1703
1708;; This function should return "foo/" for directories and "bar" for 1704;; This function should return "foo/" for directories and "bar" for
1709;; files. 1705;; files.
@@ -2394,7 +2390,7 @@ The method used must be an out-of-band method."
2394 p v nil tramp-actions-copy-out-of-band))) 2390 p v nil tramp-actions-copy-out-of-band)))
2395 2391
2396 ;; Reset the transfer process properties. 2392 ;; Reset the transfer process properties.
2397 (tramp-message orig-vec 6 "%s" (buffer-string)) 2393 (tramp-message orig-vec 6 "\n%s" (buffer-string))
2398 (tramp-set-connection-property v "process-name" nil) 2394 (tramp-set-connection-property v "process-name" nil)
2399 (tramp-set-connection-property v "process-buffer" nil))) 2395 (tramp-set-connection-property v "process-buffer" nil)))
2400 2396
@@ -2457,11 +2453,11 @@ The method used must be an out-of-band method."
2457 "Recursively delete the directory given. 2453 "Recursively delete the directory given.
2458This is like `dired-recursive-delete-directory' for Tramp files." 2454This is like `dired-recursive-delete-directory' for Tramp files."
2459 (with-parsed-tramp-file-name filename nil 2455 (with-parsed-tramp-file-name filename nil
2460 ;; Run a shell command 'rm -r <localname>' 2456 ;; Run a shell command 'rm -r <localname>'.
2461 ;; Code shamelessly stolen from the dired implementation and, um, hacked :) 2457 ;; Code shamelessly stolen from the dired implementation and, um, hacked :)
2462 (unless (file-exists-p filename) 2458 (unless (file-exists-p filename)
2463 (tramp-error v 'file-error "No such directory: %s" filename)) 2459 (tramp-error v 'file-error "No such directory: %s" filename))
2464 ;; Which is better, -r or -R? (-r works for me <daniel@danann.net>) 2460 ;; Which is better, -r or -R? (-r works for me <daniel@danann.net>).
2465 (tramp-send-command 2461 (tramp-send-command
2466 v 2462 v
2467 (format "rm -rf %s" (tramp-shell-quote-argument localname)) 2463 (format "rm -rf %s" (tramp-shell-quote-argument localname))
@@ -2699,7 +2695,8 @@ the result will be a local, non-Tramp, filename."
2699 method user host 2695 method user host
2700 (tramp-drop-volume-letter 2696 (tramp-drop-volume-letter
2701 (tramp-run-real-handler 2697 (tramp-run-real-handler
2702 'expand-file-name (list localname)))))))) 2698 'expand-file-name (list localname)))
2699 hop)))))
2703 2700
2704;;; Remote commands: 2701;;; Remote commands:
2705 2702
@@ -3609,37 +3606,48 @@ file exists and nonzero exit status otherwise."
3609 3606
3610(defun tramp-find-shell (vec) 3607(defun tramp-find-shell (vec)
3611 "Opens a shell on the remote host which groks tilde expansion." 3608 "Opens a shell on the remote host which groks tilde expansion."
3612 (unless (tramp-get-connection-property vec "remote-shell" nil) 3609 (with-connection-property vec "remote-shell"
3613 (let (shell) 3610 (let ((shell (tramp-get-method-parameter
3611 (tramp-file-name-method vec) 'tramp-remote-shell)))
3614 (with-current-buffer (tramp-get-buffer vec) 3612 (with-current-buffer (tramp-get-buffer vec)
3613 ;; CCC: "root" does not exist always, see QNAP 459. Which
3614 ;; check could we apply instead?
3615 (tramp-send-command vec "echo ~root" t) 3615 (tramp-send-command vec "echo ~root" t)
3616 (cond 3616 (when (or (string-match "^~root$" (buffer-string))
3617 ((or (string-match "^~root$" (buffer-string)) 3617 ;; The default shell (ksh93) of OpenSolaris and
3618 ;; The default shell (ksh93) of OpenSolaris and Solaris 3618 ;; Solaris is buggy. We've got reports for "SunOS
3619 ;; is buggy. We've got reports for "SunOS 5.10" and 3619 ;; 5.10" and "SunOS 5.11" so far.
3620 ;; "SunOS 5.11" so far. 3620 (string-match (regexp-opt '("SunOS 5.10" "SunOS 5.11"))
3621 (string-match (regexp-opt '("SunOS 5.10" "SunOS 5.11")) 3621 (tramp-get-connection-property vec "uname" "")))
3622 (tramp-get-connection-property vec "uname" ""))) 3622 (if (setq shell
3623 (setq shell 3623 (or (tramp-find-executable
3624 (or (tramp-find-executable 3624 vec "bash" (tramp-get-remote-path vec) t t)
3625 vec "bash" (tramp-get-remote-path vec) t t) 3625 (tramp-find-executable
3626 (tramp-find-executable 3626 vec "ksh" (tramp-get-remote-path vec) t t)))
3627 vec "ksh" (tramp-get-remote-path vec) t t))) 3627 (progn
3628 (unless shell 3628 (tramp-message
3629 (tramp-error 3629 vec 5 "Starting remote shell `%s' for tilde expansion" shell)
3630 vec 'file-error 3630 (tramp-open-shell vec shell))
3631 "Couldn't find a shell which groks tilde expansion")) 3631
3632 (tramp-message 3632 ;; Maybe it works at least for some other commands.
3633 vec 5 "Starting remote shell `%s' for tilde expansion" 3633 (setq shell
3634 (tramp-set-connection-property vec "remote-shell" shell)) 3634 (tramp-get-method-parameter
3635 (tramp-open-shell vec shell)) 3635 (tramp-file-name-method vec) 'tramp-remote-shell))
3636 3636 (tramp-message
3637 (t (tramp-message 3637 vec 2
3638 vec 5 "Remote `%s' groks tilde expansion, good" 3638 (concat
3639 (tramp-set-connection-property 3639 "Couldn't find a remote shell which groks tilde expansion, "
3640 vec "remote-shell" 3640 "using `%s'")
3641 (tramp-get-method-parameter 3641 shell)))
3642 (tramp-file-name-method vec) 'tramp-remote-shell))))))))) 3642
3643 ;; Busyboxes tend to behave strange. We check for the existence.
3644 (with-connection-property vec "busybox"
3645 (tramp-send-command vec (format "%s --version" shell) t)
3646 (let ((case-fold-search t))
3647 (and (string-match "busybox" (buffer-string)) t)))
3648
3649 ;; Return the shell.
3650 shell))))
3643 3651
3644;; Utility functions. 3652;; Utility functions.
3645 3653
@@ -3747,21 +3755,12 @@ process to set up. VEC specifies the connection."
3747 vec "uname" 3755 vec "uname"
3748 (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\"")))) 3756 (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\""))))
3749 (when (and (stringp old-uname) (not (string-equal old-uname new-uname))) 3757 (when (and (stringp old-uname) (not (string-equal old-uname new-uname)))
3750 (with-current-buffer (tramp-get-debug-buffer vec) 3758 (tramp-cleanup vec)
3751 ;; Keep the debug buffer. 3759 (tramp-message
3752 (rename-buffer 3760 vec 3
3753 (generate-new-buffer-name tramp-temp-buffer-name) 'unique) 3761 "Connection reset, because remote host changed from `%s' to `%s'"
3754 (tramp-cleanup-connection vec) 3762 old-uname new-uname)
3755 (if (= (point-min) (point-max)) 3763 (throw 'uname-changed (tramp-maybe-open-connection vec))))
3756 (kill-buffer nil)
3757 (rename-buffer (tramp-debug-buffer-name vec) 'unique))
3758 ;; We call `tramp-get-buffer' in order to keep the debug buffer.
3759 (tramp-get-buffer vec)
3760 (tramp-message
3761 vec 3
3762 "Connection reset, because remote host changed from `%s' to `%s'"
3763 old-uname new-uname)
3764 (throw 'uname-changed (tramp-maybe-open-connection vec)))))
3765 3764
3766 ;; Check whether the remote host suffers from buggy 3765 ;; Check whether the remote host suffers from buggy
3767 ;; `send-process-string'. This is known for FreeBSD (see comment in 3766 ;; `send-process-string'. This is known for FreeBSD (see comment in
@@ -3798,17 +3797,6 @@ process to set up. VEC specifies the connection."
3798 ;; Disable unexpected output. 3797 ;; Disable unexpected output.
3799 (tramp-send-command vec "mesg n; biff n" t) 3798 (tramp-send-command vec "mesg n; biff n" t)
3800 3799
3801 ;; Busyboxes tend to behave strange. We check for the existence.
3802 (with-connection-property vec "busybox"
3803 (tramp-send-command
3804 vec
3805 (format
3806 "%s --version" (tramp-get-connection-property vec "remote-shell" "echo"))
3807 t)
3808 (with-current-buffer (process-buffer proc)
3809 (let ((case-fold-search t))
3810 (and (string-match "busybox" (buffer-string)) t))))
3811
3812 ;; IRIX64 bash expands "!" even when in single quotes. This 3800 ;; IRIX64 bash expands "!" even when in single quotes. This
3813 ;; destroys our shell functions, we must disable it. See 3801 ;; destroys our shell functions, we must disable it. See
3814 ;; <http://stackoverflow.com/questions/3291692/irix-bash-shell-expands-expression-in-single-quotes-yet-shouldnt>. 3802 ;; <http://stackoverflow.com/questions/3291692/irix-bash-shell-expands-expression-in-single-quotes-yet-shouldnt>.
@@ -3902,7 +3890,7 @@ with the encoded or decoded results, respectively.")
3902 (b64 "recode data..base64" "recode base64..data") 3890 (b64 "recode data..base64" "recode base64..data")
3903 (b64 tramp-perl-encode-with-module tramp-perl-decode-with-module) 3891 (b64 tramp-perl-encode-with-module tramp-perl-decode-with-module)
3904 (b64 tramp-perl-encode tramp-perl-decode) 3892 (b64 tramp-perl-encode tramp-perl-decode)
3905 (uu "uuencode xxx" "uudecode -o /dev/stdout") 3893 (uu "uuencode xxx" "uudecode -o /dev/stdout" "test -c /dev/stdout")
3906 (uu "uuencode xxx" "uudecode -o -") 3894 (uu "uuencode xxx" "uudecode -o -")
3907 (uu "uuencode xxx" "uudecode -p") 3895 (uu "uuencode xxx" "uudecode -p")
3908 (uu "uuencode xxx" tramp-uudecode) 3896 (uu "uuencode xxx" tramp-uudecode)
@@ -3912,7 +3900,7 @@ with the encoded or decoded results, respectively.")
3912 "List of remote coding commands for inline transfer. 3900 "List of remote coding commands for inline transfer.
3913Each item is a list that looks like this: 3901Each item is a list that looks like this:
3914 3902
3915\(FORMAT ENCODING DECODING\) 3903\(FORMAT ENCODING DECODING [TEST]\)
3916 3904
3917FORMAT is symbol describing the encoding/decoding format. It can be 3905FORMAT is symbol describing the encoding/decoding format. It can be
3918`b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing. 3906`b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing.
@@ -3926,7 +3914,10 @@ input.
3926 3914
3927If they are variables, this variable is a string containing a Perl 3915If they are variables, this variable is a string containing a Perl
3928implementation for this functionality. This Perl program will be transferred 3916implementation for this functionality. This Perl program will be transferred
3929to the remote host, and it is available as shell function with the same name.") 3917to the remote host, and it is available as shell function with the same name.
3918
3919The optional TEST command can be used for further tests, whether
3920ENCODING and DECODING are applicable.")
3930 3921
3931(defun tramp-find-inline-encoding (vec) 3922(defun tramp-find-inline-encoding (vec)
3932 "Find an inline transfer encoding that works. 3923 "Find an inline transfer encoding that works.
@@ -3935,7 +3926,8 @@ Goes through the list `tramp-local-coding-commands' and
3935 (save-excursion 3926 (save-excursion
3936 (let ((local-commands tramp-local-coding-commands) 3927 (let ((local-commands tramp-local-coding-commands)
3937 (magic "xyzzy") 3928 (magic "xyzzy")
3938 loc-enc loc-dec rem-enc rem-dec litem ritem found) 3929 (p (tramp-get-connection-process vec))
3930 loc-enc loc-dec rem-enc rem-dec rem-test litem ritem found)
3939 (while (and local-commands (not found)) 3931 (while (and local-commands (not found))
3940 (setq litem (pop local-commands)) 3932 (setq litem (pop local-commands))
3941 (catch 'wont-work-local 3933 (catch 'wont-work-local
@@ -3968,6 +3960,13 @@ Goes through the list `tramp-local-coding-commands' and
3968 (when (equal format (nth 0 ritem)) 3960 (when (equal format (nth 0 ritem))
3969 (setq rem-enc (nth 1 ritem)) 3961 (setq rem-enc (nth 1 ritem))
3970 (setq rem-dec (nth 2 ritem)) 3962 (setq rem-dec (nth 2 ritem))
3963 (setq rem-test (nth 3 ritem))
3964 ;; Check the remote test command if exists.
3965 (when (stringp rem-test)
3966 (tramp-message
3967 vec 5 "Checking remote test command `%s'" rem-test)
3968 (unless (tramp-send-command-and-check vec rem-test t)
3969 (throw 'wont-work-remote nil)))
3971 ;; Check if remote encoding and decoding commands can be 3970 ;; Check if remote encoding and decoding commands can be
3972 ;; called remotely with null input and output. This makes 3971 ;; called remotely with null input and output. This makes
3973 ;; sure there are no syntax errors and the command is really 3972 ;; sure there are no syntax errors and the command is really
@@ -4019,15 +4018,16 @@ Goes through the list `tramp-local-coding-commands' and
4019 (tramp-error 4018 (tramp-error
4020 vec 'file-error "Couldn't find an inline transfer encoding")) 4019 vec 'file-error "Couldn't find an inline transfer encoding"))
4021 4020
4022 ;; Set connection properties. 4021 ;; Set connection properties. Since the commands are risky (due
4022 ;; to output direction), we cache them in the process cache.
4023 (tramp-message vec 5 "Using local encoding `%s'" loc-enc) 4023 (tramp-message vec 5 "Using local encoding `%s'" loc-enc)
4024 (tramp-set-connection-property vec "local-encoding" loc-enc) 4024 (tramp-set-connection-property p "local-encoding" loc-enc)
4025 (tramp-message vec 5 "Using local decoding `%s'" loc-dec) 4025 (tramp-message vec 5 "Using local decoding `%s'" loc-dec)
4026 (tramp-set-connection-property vec "local-decoding" loc-dec) 4026 (tramp-set-connection-property p "local-decoding" loc-dec)
4027 (tramp-message vec 5 "Using remote encoding `%s'" rem-enc) 4027 (tramp-message vec 5 "Using remote encoding `%s'" rem-enc)
4028 (tramp-set-connection-property vec "remote-encoding" rem-enc) 4028 (tramp-set-connection-property p "remote-encoding" rem-enc)
4029 (tramp-message vec 5 "Using remote decoding `%s'" rem-dec) 4029 (tramp-message vec 5 "Using remote decoding `%s'" rem-dec)
4030 (tramp-set-connection-property vec "remote-decoding" rem-dec)))) 4030 (tramp-set-connection-property p "remote-decoding" rem-dec))))
4031 4031
4032(defun tramp-call-local-coding-command (cmd input output) 4032(defun tramp-call-local-coding-command (cmd input output)
4033 "Call the local encoding or decoding command. 4033 "Call the local encoding or decoding command.
@@ -4065,8 +4065,8 @@ Goes through the list `tramp-inline-compress-commands'."
4065 (save-excursion 4065 (save-excursion
4066 (let ((commands tramp-inline-compress-commands) 4066 (let ((commands tramp-inline-compress-commands)
4067 (magic "xyzzy") 4067 (magic "xyzzy")
4068 item compress decompress 4068 (p (tramp-get-connection-process vec))
4069 found) 4069 item compress decompress found)
4070 (while (and commands (not found)) 4070 (while (and commands (not found))
4071 (catch 'next 4071 (catch 'next
4072 (setq item (pop commands) 4072 (setq item (pop commands)
@@ -4100,16 +4100,18 @@ Goes through the list `tramp-inline-compress-commands'."
4100 ;; Did we find something? 4100 ;; Did we find something?
4101 (if found 4101 (if found
4102 (progn 4102 (progn
4103 ;; Set connection properties. 4103 ;; Set connection properties. Since the commands are
4104 ;; risky (due to output direction), we cache them in the
4105 ;; process cache.
4104 (tramp-message 4106 (tramp-message
4105 vec 5 "Using inline transfer compress command `%s'" compress) 4107 vec 5 "Using inline transfer compress command `%s'" compress)
4106 (tramp-set-connection-property vec "inline-compress" compress) 4108 (tramp-set-connection-property p "inline-compress" compress)
4107 (tramp-message 4109 (tramp-message
4108 vec 5 "Using inline transfer decompress command `%s'" decompress) 4110 vec 5 "Using inline transfer decompress command `%s'" decompress)
4109 (tramp-set-connection-property vec "inline-decompress" decompress)) 4111 (tramp-set-connection-property p "inline-decompress" decompress))
4110 4112
4111 (tramp-set-connection-property vec "inline-compress" nil) 4113 (tramp-set-connection-property p "inline-compress" nil)
4112 (tramp-set-connection-property vec "inline-decompress" nil) 4114 (tramp-set-connection-property p "inline-decompress" nil)
4113 (tramp-message 4115 (tramp-message
4114 vec 2 "Couldn't find an inline transfer compress command"))))) 4116 vec 2 "Couldn't find an inline transfer compress command")))))
4115 4117
@@ -4117,18 +4119,43 @@ Goes through the list `tramp-inline-compress-commands'."
4117 "Expands VEC according to `tramp-default-proxies-alist'. 4119 "Expands VEC according to `tramp-default-proxies-alist'.
4118Gateway hops are already opened." 4120Gateway hops are already opened."
4119 (let ((target-alist `(,vec)) 4121 (let ((target-alist `(,vec))
4120 (choices tramp-default-proxies-alist) 4122 (hops (or (tramp-file-name-hop vec) ""))
4121 item proxy) 4123 (item vec)
4124 choices proxy)
4125
4126 ;; Ad-hoc proxy definitions.
4127 (dolist (proxy (reverse (split-string hops tramp-postfix-hop-regexp 'omit)))
4128 (let ((user (tramp-file-name-user item))
4129 (host (tramp-file-name-host item))
4130 (proxy (concat
4131 tramp-prefix-format proxy tramp-postfix-host-format)))
4132 (tramp-message
4133 vec 5 "Add proxy (\"%s\" \"%s\" \"%s\")"
4134 (and (stringp host) (regexp-quote host))
4135 (and (stringp user) (regexp-quote user))
4136 proxy)
4137 ;; Add the hop.
4138 (add-to-list
4139 'tramp-default-proxies-alist
4140 (list (and (stringp host) (regexp-quote host))
4141 (and (stringp user) (regexp-quote user))
4142 proxy))
4143 (setq item (tramp-dissect-file-name proxy))))
4144 ;; Save the new value.
4145 (when (and hops tramp-save-ad-hoc-proxies)
4146 (customize-save-variable
4147 'tramp-default-proxies-alist tramp-default-proxies-alist))
4122 4148
4123 ;; Look for proxy hosts to be passed. 4149 ;; Look for proxy hosts to be passed.
4150 (setq choices tramp-default-proxies-alist)
4124 (while choices 4151 (while choices
4125 (setq item (pop choices) 4152 (setq item (pop choices)
4126 proxy (eval (nth 2 item))) 4153 proxy (eval (nth 2 item)))
4127 (when (and 4154 (when (and
4128 ;; host 4155 ;; Host.
4129 (string-match (or (eval (nth 0 item)) "") 4156 (string-match (or (eval (nth 0 item)) "")
4130 (or (tramp-file-name-host (car target-alist)) "")) 4157 (or (tramp-file-name-host (car target-alist)) ""))
4131 ;; user 4158 ;; User.
4132 (string-match (or (eval (nth 1 item)) "") 4159 (string-match (or (eval (nth 1 item)) "")
4133 (or (tramp-file-name-user (car target-alist)) ""))) 4160 (or (tramp-file-name-user (car target-alist)) "")))
4134 (if (null proxy) 4161 (if (null proxy)
@@ -4164,7 +4191,7 @@ Gateway hops are already opened."
4164 'target-alist 4191 'target-alist
4165 (vector 4192 (vector
4166 (tramp-file-name-method hop) (tramp-file-name-user hop) 4193 (tramp-file-name-method hop) (tramp-file-name-user hop)
4167 (tramp-compat-funcall 'tramp-gw-open-connection vec gw hop) nil)) 4194 (tramp-compat-funcall 'tramp-gw-open-connection vec gw hop) nil nil))
4168 ;; For the password prompt, we need the correct values. 4195 ;; For the password prompt, we need the correct values.
4169 ;; Therefore, we must remember the gateway vector. But we 4196 ;; Therefore, we must remember the gateway vector. But we
4170 ;; cannot do it as connection property, because it shouldn't 4197 ;; cannot do it as connection property, because it shouldn't
@@ -4212,6 +4239,9 @@ Gateway hops are already opened."
4212 ;; Result. 4239 ;; Result.
4213 target-alist)) 4240 target-alist))
4214 4241
4242(defvar tramp-current-connection nil
4243 "Last connection timestamp.")
4244
4215(defun tramp-maybe-open-connection (vec) 4245(defun tramp-maybe-open-connection (vec)
4216 "Maybe open a connection VEC. 4246 "Maybe open a connection VEC.
4217Does not do anything if a connection is already open, but re-opens the 4247Does not do anything if a connection is already open, but re-opens the
@@ -4222,6 +4252,16 @@ connection if a previous connection has died for some reason."
4222 (process-environment (copy-sequence process-environment)) 4252 (process-environment (copy-sequence process-environment))
4223 (pos (with-current-buffer (tramp-get-connection-buffer vec) (point)))) 4253 (pos (with-current-buffer (tramp-get-connection-buffer vec) (point))))
4224 4254
4255 ;; If Tramp opens the same connection within a short time frame,
4256 ;; there is a problem. We shall signal this.
4257 (unless (or (and p (processp p) (memq (process-status p) '(run open)))
4258 (not (equal (butlast (append vec nil))
4259 (car tramp-current-connection)))
4260 (> (tramp-time-diff
4261 (current-time) (cdr tramp-current-connection))
4262 5))
4263 (throw 'suppress 'suppress))
4264
4225 ;; If too much time has passed since last command was sent, look 4265 ;; If too much time has passed since last command was sent, look
4226 ;; whether process is still alive. If it isn't, kill it. When 4266 ;; whether process is still alive. If it isn't, kill it. When
4227 ;; using ssh, it can sometimes happen that the remote end has 4267 ;; using ssh, it can sometimes happen that the remote end has
@@ -4242,9 +4282,7 @@ connection if a previous connection has died for some reason."
4242 ;; The error will be caught locally. 4282 ;; The error will be caught locally.
4243 (tramp-error vec 'file-error "Awake did fail"))) 4283 (tramp-error vec 'file-error "Awake did fail")))
4244 (file-error 4284 (file-error
4245 (tramp-flush-connection-property vec) 4285 (tramp-cleanup vec)
4246 (tramp-flush-connection-property p)
4247 (delete-process p)
4248 (setq p nil))) 4286 (setq p nil)))
4249 4287
4250 ;; New connection must be opened. 4288 ;; New connection must be opened.
@@ -4293,6 +4331,8 @@ connection if a previous connection has died for some reason."
4293 (tramp-set-connection-property p "vector" vec) 4331 (tramp-set-connection-property p "vector" vec)
4294 (set-process-sentinel p 'tramp-process-sentinel) 4332 (set-process-sentinel p 'tramp-process-sentinel)
4295 (tramp-compat-set-process-query-on-exit-flag p nil) 4333 (tramp-compat-set-process-query-on-exit-flag p nil)
4334 (setq tramp-current-connection
4335 (cons (butlast (append vec nil)) (current-time)))
4296 4336
4297 (tramp-message 4337 (tramp-message
4298 vec 6 "%s" (mapconcat 'identity (process-command p) " ")) 4338 vec 6 "%s" (mapconcat 'identity (process-command p) " "))
@@ -4401,11 +4441,7 @@ connection if a previous connection has died for some reason."
4401 4441
4402 ;; When the user did interrupt, we must cleanup. 4442 ;; When the user did interrupt, we must cleanup.
4403 (quit 4443 (quit
4404 (let ((p (tramp-get-connection-process vec))) 4444 (tramp-cleanup vec)
4405 (when (and p (processp p))
4406 (tramp-flush-connection-property vec)
4407 (tramp-flush-connection-property p)
4408 (delete-process p)))
4409 ;; Propagate the quit signal. 4445 ;; Propagate the quit signal.
4410 (signal (car err) (cdr err))))))) 4446 (signal (car err) (cdr err)))))))
4411 4447
@@ -4942,9 +4978,10 @@ the length of the file to be compressed.
4942If no corresponding command is found, nil is returned." 4978If no corresponding command is found, nil is returned."
4943 (when (and (integerp tramp-inline-compress-start-size) 4979 (when (and (integerp tramp-inline-compress-start-size)
4944 (> size tramp-inline-compress-start-size)) 4980 (> size tramp-inline-compress-start-size))
4945 (with-connection-property vec prop 4981 (with-connection-property (tramp-get-connection-process vec) prop
4946 (tramp-find-inline-compress vec) 4982 (tramp-find-inline-compress vec)
4947 (tramp-get-connection-property vec prop nil)))) 4983 (tramp-get-connection-property
4984 (tramp-get-connection-process vec) prop nil))))
4948 4985
4949(defun tramp-get-inline-coding (vec prop size) 4986(defun tramp-get-inline-coding (vec prop size)
4950 "Return the coding command related to PROP. 4987 "Return the coding command related to PROP.
@@ -4962,9 +4999,10 @@ function cell is returned to be applied on a buffer."
4962 ;; no inline coding is found. 4999 ;; no inline coding is found.
4963 (ignore-errors 5000 (ignore-errors
4964 (let ((coding 5001 (let ((coding
4965 (with-connection-property vec prop 5002 (with-connection-property (tramp-get-connection-process vec) prop
4966 (tramp-find-inline-encoding vec) 5003 (tramp-find-inline-encoding vec)
4967 (tramp-get-connection-property vec prop nil))) 5004 (tramp-get-connection-property
5005 (tramp-get-connection-process vec) prop nil)))
4968 (prop1 (if (string-match "encoding" prop) 5006 (prop1 (if (string-match "encoding" prop)
4969 "inline-compress" "inline-decompress")) 5007 "inline-compress" "inline-decompress"))
4970 compress) 5008 compress)
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index f1535ae64c0..1ea2719a23f 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -43,7 +43,7 @@
43 ;; We define an empty command, because `tramp-smb-call-winexe' 43 ;; We define an empty command, because `tramp-smb-call-winexe'
44 ;; opens already the powershell. Used in `tramp-handle-shell-command'. 44 ;; opens already the powershell. Used in `tramp-handle-shell-command'.
45 (tramp-remote-shell "") 45 (tramp-remote-shell "")
46 ;; This is just a guess. We don't know whether the share "$C" 46 ;; This is just a guess. We don't know whether the share "C$"
47 ;; is available for public use, and whether the user has write 47 ;; is available for public use, and whether the user has write
48 ;; access. 48 ;; access.
49 (tramp-tmpdir "/C$/Temp")))) 49 (tramp-tmpdir "/C$/Temp"))))
@@ -82,8 +82,18 @@ call, letting the SMB client use the default one."
82(defvar tramp-smb-version nil 82(defvar tramp-smb-version nil
83 "Version string of the SMB client.") 83 "Version string of the SMB client.")
84 84
85(defconst tramp-smb-prompt "^smb: .+> \\|^\\s-+Server\\s-+Comment$" 85(defconst tramp-smb-server-version
86 "Regexp used as prompt in smbclient.") 86 "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]"
87 "Regexp of SMB server identification.")
88
89(defconst tramp-smb-prompt "^\\(smb:\\|PS\\) .+> \\|^\\s-+Server\\s-+Comment$"
90 "Regexp used as prompt in smbclient or powershell.")
91
92(defconst tramp-smb-wrong-passwd-regexp
93 (regexp-opt
94 '("NT_STATUS_LOGON_FAILURE"
95 "NT_STATUS_WRONG_PASSWORD"))
96 "Regexp for login error strings of SMB servers.")
87 97
88(defconst tramp-smb-errors 98(defconst tramp-smb-errors
89 (mapconcat 99 (mapconcat
@@ -155,6 +165,16 @@ This list is used for login to SMB servers.
155 165
156See `tramp-actions-before-shell' for more info.") 166See `tramp-actions-before-shell' for more info.")
157 167
168(defconst tramp-smb-actions-with-tar
169 '((tramp-password-prompt-regexp tramp-action-password)
170 (tramp-wrong-passwd-regexp tramp-action-permission-denied)
171 (tramp-smb-errors tramp-action-permission-denied)
172 (tramp-process-alive-regexp tramp-smb-action-with-tar))
173 "List of pattern/action pairs.
174This list is used for tar-like copy of directories.
175
176See `tramp-actions-before-shell' for more info.")
177
158;; New handlers should be added here. 178;; New handlers should be added here.
159(defconst tramp-smb-file-name-handler-alist 179(defconst tramp-smb-file-name-handler-alist
160 '( 180 '(
@@ -205,12 +225,14 @@ See `tramp-actions-before-shell' for more info.")
205 (make-directory . tramp-smb-handle-make-directory) 225 (make-directory . tramp-smb-handle-make-directory)
206 (make-directory-internal . tramp-smb-handle-make-directory-internal) 226 (make-directory-internal . tramp-smb-handle-make-directory-internal)
207 (make-symbolic-link . tramp-smb-handle-make-symbolic-link) 227 (make-symbolic-link . tramp-smb-handle-make-symbolic-link)
228 (process-file . tramp-smb-handle-process-file)
208 (rename-file . tramp-smb-handle-rename-file) 229 (rename-file . tramp-smb-handle-rename-file)
209 (set-file-modes . tramp-smb-handle-set-file-modes) 230 (set-file-modes . tramp-smb-handle-set-file-modes)
210 ;; `set-file-selinux-context' performed by default handler. 231 ;; `set-file-selinux-context' performed by default handler.
211 (set-file-times . ignore) 232 (set-file-times . ignore)
212 (set-visited-file-modtime . ignore) 233 (set-visited-file-modtime . ignore)
213 (shell-command . ignore) 234 (shell-command . tramp-handle-shell-command)
235 (start-file-process . tramp-smb-handle-start-file-process)
214 (substitute-in-file-name . tramp-smb-handle-substitute-in-file-name) 236 (substitute-in-file-name . tramp-smb-handle-substitute-in-file-name)
215 (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) 237 (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
216 (vc-registered . ignore) 238 (vc-registered . ignore)
@@ -220,11 +242,34 @@ See `tramp-actions-before-shell' for more info.")
220 "Alist of handler functions for Tramp SMB method. 242 "Alist of handler functions for Tramp SMB method.
221Operations not mentioned here will be handled by the default Emacs primitives.") 243Operations not mentioned here will be handled by the default Emacs primitives.")
222 244
245;; Options for remote processes via winexe.
246(defcustom tramp-smb-winexe-program "winexe"
247 "Name of winexe client to run.
248If it isn't found in the local $PATH, the absolute path of winexe
249shall be given. This is needed for remote processes."
250 :group 'tramp
251 :type 'string
252 :version "24.2")
253
254(defcustom tramp-smb-winexe-shell-command "powershell.exe"
255 "Shell to be used for processes on remote machines.
256This must be Powershell V2 compatible."
257 :group 'tramp
258 :type 'string
259 :version "24.2")
260
261(defcustom tramp-smb-winexe-shell-command-switch "-file -"
262 "Command switch used together with `tramp-smb-winexe-shell-command'.
263This can be used to disable echo etc."
264 :group 'tramp
265 :type 'string
266 :version "24.2")
267
223;;;###tramp-autoload 268;;;###tramp-autoload
224(defsubst tramp-smb-file-name-p (filename) 269(defsubst tramp-smb-file-name-p (filename)
225 "Check if it's a filename for SMB servers." 270 "Check if it's a filename for SMB servers."
226 (let ((v (tramp-dissect-file-name filename))) 271 (string= (tramp-file-name-method (tramp-dissect-file-name filename))
227 (string= (tramp-file-name-method v) tramp-smb-method))) 272 tramp-smb-method))
228 273
229;;;###tramp-autoload 274;;;###tramp-autoload
230(defun tramp-smb-file-name-handler (operation &rest args) 275(defun tramp-smb-file-name-handler (operation &rest args)
@@ -287,14 +332,31 @@ pass to the OPERATION."
287 "error with add-name-to-file, see buffer `%s' for details" 332 "error with add-name-to-file, see buffer `%s' for details"
288 (buffer-name)))))) 333 (buffer-name))))))
289 334
335(defun tramp-smb-action-with-tar (proc vec)
336 "Untar from connection buffer."
337 (if (not (memq (process-status proc) '(run open)))
338 (throw 'tramp-action 'process-died)
339
340 (with-current-buffer (tramp-get-connection-buffer vec)
341 (goto-char (point-min))
342 (when (search-forward-regexp tramp-smb-server-version nil t)
343 ;; There might be a hidden password prompt.
344 (widen)
345 (forward-line)
346 (tramp-message vec 6 (buffer-substring (point-min) (point)))
347 (delete-region (point-min) (point))
348 (throw 'tramp-action 'ok)))))
349
290(defun tramp-smb-handle-copy-directory 350(defun tramp-smb-handle-copy-directory
291 (dirname newname &optional keep-date parents copy-contents) 351 (dirname newname &optional keep-date parents copy-contents)
292 "Like `copy-directory' for Tramp files. KEEP-DATE is not handled." 352 "Like `copy-directory' for Tramp files."
293 (setq dirname (expand-file-name dirname) 353 (setq dirname (expand-file-name dirname)
294 newname (expand-file-name newname)) 354 newname (expand-file-name newname))
295 (let ((t1 (tramp-tramp-file-p dirname)) 355 (let ((t1 (tramp-tramp-file-p dirname))
296 (t2 (tramp-tramp-file-p newname))) 356 (t2 (tramp-tramp-file-p newname)))
297 (with-parsed-tramp-file-name (if t1 dirname newname) nil 357 (with-parsed-tramp-file-name (if t1 dirname newname) nil
358 (tramp-with-progress-reporter
359 v 0 (format "Copying %s to %s" dirname newname)
298 (cond 360 (cond
299 ;; We must use a local temporary directory. 361 ;; We must use a local temporary directory.
300 ((and t1 t2) 362 ((and t1 t2)
@@ -311,46 +373,121 @@ pass to the OPERATION."
311 373
312 ;; We can copy recursively. 374 ;; We can copy recursively.
313 ((or t1 t2) 375 ((or t1 t2)
314 (let ((prompt (tramp-smb-send-command v "prompt")) 376 (when (and (file-directory-p newname)
315 (recurse (tramp-smb-send-command v "recurse"))) 377 (not (string-equal (file-name-nondirectory dirname)
316 (unless (file-directory-p newname) 378 (file-name-nondirectory newname))))
379 (setq newname
380 (expand-file-name
381 (file-name-nondirectory dirname) newname))
382 (if t2 (setq v (tramp-dissect-file-name newname))))
383 (if (not (file-directory-p newname))
317 (make-directory newname parents)) 384 (make-directory newname parents))
385
386 (setq tramp-current-method (tramp-file-name-method v)
387 tramp-current-user (tramp-file-name-user v)
388 tramp-current-host (tramp-file-name-real-host v))
389
390 (let* ((real-user (tramp-file-name-real-user v))
391 (real-host (tramp-file-name-real-host v))
392 (domain (tramp-file-name-domain v))
393 (port (tramp-file-name-port v))
394 (share (tramp-smb-get-share v))
395 (localname (file-name-as-directory
396 (replace-regexp-in-string
397 "\\\\" "/" (tramp-smb-get-localname v))))
398 (tmpdir (make-temp-name
399 (expand-file-name
400 tramp-temp-name-prefix
401 (tramp-compat-temporary-file-directory))))
402 (args (list tramp-smb-program
403 (concat "//" real-host "/" share) "-E")))
404
405 (if (not (zerop (length real-user)))
406 (setq args (append args (list "-U" real-user)))
407 (setq args (append args (list "-N"))))
408
409 (when domain (setq args (append args (list "-W" domain))))
410 (when port (setq args (append args (list "-p" port))))
411 (when tramp-smb-conf
412 (setq args (append args (list "-s" tramp-smb-conf))))
413 (setq args
414 (if t1
415 ;; Source is remote.
416 (append args
417 (list "-D" (shell-quote-argument localname)
418 "-c" (shell-quote-argument "tar qc - *")
419 "|" "tar" "xfC" "-"
420 (shell-quote-argument tmpdir)))
421 ;; Target is remote.
422 (append (list "tar" "cfC" "-" (shell-quote-argument dirname)
423 "." "|")
424 args
425 (list "-D" (shell-quote-argument localname)
426 "-c" (shell-quote-argument "tar qx -")))))
427
318 (unwind-protect 428 (unwind-protect
319 (unless 429 (with-temp-buffer
320 (and 430 ;; Set the transfer process properties.
321 prompt recurse 431 (tramp-set-connection-property
322 (tramp-smb-send-command 432 v "process-name" (buffer-name (current-buffer)))
323 v (format "cd \"%s\"" (tramp-smb-get-localname v))) 433 (tramp-set-connection-property
324 (tramp-smb-send-command 434 v "process-buffer" (current-buffer))
325 v (format "lcd \"%s\"" (if t1 newname dirname))) 435
326 (if t1 436 (when t1
327 (tramp-smb-send-command v "mget *") 437 ;; The smbclient tar command creates always complete
328 (tramp-smb-send-command v "mput *"))) 438 ;; paths. We must emulate the directory structure,
329 ;; Error. 439 ;; and symlink to the real target.
330 (with-current-buffer (tramp-get-connection-buffer v) 440 (make-directory
331 (goto-char (point-min)) 441 (expand-file-name ".." (concat tmpdir localname)) 'parents)
332 (search-forward-regexp tramp-smb-errors nil t) 442 (make-symbolic-link
333 (tramp-error 443 newname (directory-file-name (concat tmpdir localname))))
334 v 'file-error 444
335 "%s `%s'" (match-string 0) (if t1 dirname newname)))) 445 ;; Use an asynchronous processes. By this, password
336 ;; Go home. 446 ;; can be handled.
337 (tramp-smb-send-command 447 (let* ((default-directory tmpdir)
338 v (format 448 (p (start-process-shell-command
339 "cd %s" (if (tramp-smb-get-cifs-capabilities v) "/" "\\"))) 449 (tramp-get-connection-name v)
340 ;; Toggle prompt and recurse OFF. 450 (tramp-get-connection-buffer v)
341 (if prompt (tramp-smb-send-command v "prompt")) 451 (mapconcat 'identity args " "))))
342 (if recurse (tramp-smb-send-command v "recurse"))))) 452
453 (tramp-message
454 v 6 "%s" (mapconcat 'identity (process-command p) " "))
455 (tramp-compat-set-process-query-on-exit-flag p nil)
456 (tramp-process-actions p v nil tramp-smb-actions-with-tar)
457
458 (while (memq (process-status p) '(run open))
459 (sit-for 0.1))
460 (tramp-message v 6 "\n%s" (buffer-string))))
461
462 ;; Reset the transfer process properties.
463 (tramp-set-connection-property v "process-name" nil)
464 (tramp-set-connection-property v "process-buffer" nil)
465 (when t1 (delete-directory tmpdir 'recurse))))
466
467 ;; Handle KEEP-DATE argument.
468 (when keep-date
469 (set-file-times newname (nth 5 (file-attributes dirname))))
470
471 ;; Set the mode.
472 (unless keep-date
473 (set-file-modes newname (tramp-default-file-modes dirname)))
474
475 ;; When newname did exist, we have wrong cached values.
476 (when t2
477 (with-parsed-tramp-file-name newname nil
478 (tramp-flush-file-property v (file-name-directory localname))
479 (tramp-flush-file-property v localname))))
343 480
344 ;; We must do it file-wise. 481 ;; We must do it file-wise.
345 (t 482 (t
346 (tramp-run-real-handler 483 (tramp-run-real-handler
347 'copy-directory (list dirname newname keep-date parents))))))) 484 'copy-directory (list dirname newname keep-date parents))))))))
348 485
349(defun tramp-smb-handle-copy-file 486(defun tramp-smb-handle-copy-file
350 (filename newname &optional ok-if-already-exists keep-date 487 (filename newname &optional ok-if-already-exists keep-date
351 preserve-uid-gid preserve-selinux-context) 488 preserve-uid-gid preserve-selinux-context)
352 "Like `copy-file' for Tramp files. 489 "Like `copy-file' for Tramp files.
353KEEP-DATE is not handled in case NEWNAME resides on an SMB server. 490KEEP-DATE has no effect in case NEWNAME resides on an SMB server.
354PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored." 491PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored."
355 (setq filename (expand-file-name filename) 492 (setq filename (expand-file-name filename)
356 newname (expand-file-name newname)) 493 newname (expand-file-name newname))
@@ -358,40 +495,43 @@ PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored."
358 (tramp-dissect-file-name (if (file-remote-p filename) filename newname)) 495 (tramp-dissect-file-name (if (file-remote-p filename) filename newname))
359 0 (format "Copying %s to %s" filename newname) 496 0 (format "Copying %s to %s" filename newname)
360 497
361 (let ((tmpfile (file-local-copy filename))) 498 (if (file-directory-p filename)
362 499 (tramp-compat-copy-directory filename newname keep-date t t)
363 (if tmpfile 500
364 ;; Remote filename. 501 (let ((tmpfile (file-local-copy filename)))
365 (condition-case err 502 (if tmpfile
366 (rename-file tmpfile newname ok-if-already-exists) 503 ;; Remote filename.
367 ((error quit) 504 (condition-case err
368 (delete-file tmpfile) 505 (rename-file tmpfile newname ok-if-already-exists)
369 (signal (car err) (cdr err)))) 506 ((error quit)
370 507 (delete-file tmpfile)
371 ;; Remote newname. 508 (signal (car err) (cdr err))))
372 (when (file-directory-p newname) 509
373 (setq newname 510 ;; Remote newname.
374 (expand-file-name (file-name-nondirectory filename) newname))) 511 (when (file-directory-p newname)
375 512 (setq newname
376 (with-parsed-tramp-file-name newname nil 513 (expand-file-name (file-name-nondirectory filename) newname)))
377 (when (and (not ok-if-already-exists) 514
378 (file-exists-p newname)) 515 (with-parsed-tramp-file-name newname nil
379 (tramp-error v 'file-already-exists newname)) 516 (when (and (not ok-if-already-exists)
380 517 (file-exists-p newname))
381 ;; We must also flush the cache of the directory, because 518 (tramp-error v 'file-already-exists newname))
382 ;; `file-attributes' reads the values from there. 519
383 (tramp-flush-file-property v (file-name-directory localname)) 520 ;; We must also flush the cache of the directory, because
384 (tramp-flush-file-property v localname) 521 ;; `file-attributes' reads the values from there.
385 (unless (tramp-smb-get-share v) 522 (tramp-flush-file-property v (file-name-directory localname))
386 (tramp-error 523 (tramp-flush-file-property v localname)
387 v 'file-error "Target `%s' must contain a share name" newname)) 524 (unless (tramp-smb-get-share v)
388 (unless (tramp-smb-send-command 525 (tramp-error
389 v (format "put \"%s\" \"%s\"" 526 v 'file-error "Target `%s' must contain a share name" newname))
390 filename (tramp-smb-get-localname v))) 527 (unless (tramp-smb-send-command
391 (tramp-error v 'file-error "Cannot copy `%s'" filename)))))) 528 v (format "put \"%s\" \"%s\""
529 filename (tramp-smb-get-localname v)))
530 (tramp-error v 'file-error "Cannot copy `%s'" filename))))))
392 531
393 ;; KEEP-DATE handling. 532 ;; KEEP-DATE handling.
394 (when keep-date (set-file-times newname (nth 5 (file-attributes filename))))) 533 (when keep-date
534 (set-file-times newname (nth 5 (file-attributes filename))))))
395 535
396(defun tramp-smb-handle-delete-directory (directory &optional recursive) 536(defun tramp-smb-handle-delete-directory (directory &optional recursive)
397 "Like `delete-directory' for Tramp files." 537 "Like `delete-directory' for Tramp files."
@@ -539,7 +679,7 @@ PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored."
539 "Implement `file-attributes' for Tramp files using stat command." 679 "Implement `file-attributes' for Tramp files using stat command."
540 (tramp-message 680 (tramp-message
541 vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec)) 681 vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec))
542 (with-current-buffer (tramp-get-buffer vec) 682 (with-current-buffer (tramp-get-connection-buffer vec)
543 (let* (size id link uid gid atime mtime ctime mode inode) 683 (let* (size id link uid gid atime mtime ctime mode inode)
544 (when (tramp-smb-send-command 684 (when (tramp-smb-send-command
545 vec (format "stat \"%s\"" (tramp-smb-get-localname vec))) 685 vec (format "stat \"%s\"" (tramp-smb-get-localname vec)))
@@ -845,44 +985,170 @@ target of the symlink differ."
845 "error with make-symbolic-link, see buffer `%s' for details" 985 "error with make-symbolic-link, see buffer `%s' for details"
846 (buffer-name)))))) 986 (buffer-name))))))
847 987
988(defun tramp-smb-handle-process-file
989 (program &optional infile destination display &rest args)
990 "Like `process-file' for Tramp files."
991 ;; The implementation is not complete yet.
992 (when (and (numberp destination) (zerop destination))
993 (error "Implementation does not handle immediate return"))
994
995 (with-parsed-tramp-file-name default-directory nil
996 (let* ((name (file-name-nondirectory program))
997 (name1 name)
998 (i 0)
999 input tmpinput outbuf command ret)
1000
1001 ;; Determine input.
1002 (when infile
1003 (setq infile (expand-file-name infile))
1004 (if (tramp-equal-remote default-directory infile)
1005 ;; INFILE is on the same remote host.
1006 (setq input (with-parsed-tramp-file-name infile nil localname))
1007 ;; INFILE must be copied to remote host.
1008 (setq input (tramp-make-tramp-temp-file v)
1009 tmpinput (tramp-make-tramp-file-name method user host input))
1010 (copy-file infile tmpinput t))
1011 ;; Transform input into a filename powershell does understand.
1012 (setq input (format "//%s%s" host input)))
1013
1014 ;; Determine output.
1015 (cond
1016 ;; Just a buffer.
1017 ((bufferp destination)
1018 (setq outbuf destination))
1019 ;; A buffer name.
1020 ((stringp destination)
1021 (setq outbuf (get-buffer-create destination)))
1022 ;; (REAL-DESTINATION ERROR-DESTINATION)
1023 ((consp destination)
1024 ;; output.
1025 (cond
1026 ((bufferp (car destination))
1027 (setq outbuf (car destination)))
1028 ((stringp (car destination))
1029 (setq outbuf (get-buffer-create (car destination))))
1030 ((car destination)
1031 (setq outbuf (current-buffer))))
1032 ;; stderr.
1033 (tramp-message v 2 "%s" "STDERR not supported"))
1034 ;; 't
1035 (destination
1036 (setq outbuf (current-buffer))))
1037
1038 ;; Construct command.
1039 (setq command (mapconcat 'identity (cons program args) " ")
1040 command (if input
1041 (format
1042 "get-content %s | & %s"
1043 (tramp-smb-shell-quote-argument input) command)
1044 (format "& %s" command)))
1045
1046 (while (get-process name1)
1047 ;; NAME must be unique as process name.
1048 (setq i (1+ i)
1049 name1 (format "%s<%d>" name i)))
1050
1051 ;; Set the new process properties.
1052 (tramp-set-connection-property v "process-name" name1)
1053 (tramp-set-connection-property
1054 v "process-buffer"
1055 (or outbuf (generate-new-buffer tramp-temp-buffer-name)))
1056
1057 ;; Call it.
1058 (condition-case nil
1059 (with-current-buffer (tramp-get-connection-buffer v)
1060 ;; Preserve buffer contents.
1061 (narrow-to-region (point-max) (point-max))
1062 (tramp-smb-call-winexe v)
1063 (when (tramp-smb-get-share v)
1064 (tramp-smb-send-command
1065 v (format "cd \"//%s%s\"" host (file-name-directory localname))))
1066 (tramp-smb-send-command v command)
1067 ;; Preserve command output.
1068 (narrow-to-region (point-max) (point-max))
1069 (let ((p (tramp-get-connection-process v)))
1070 (tramp-smb-send-command v "exit $lasterrorcode")
1071 (while (memq (process-status p) '(run open))
1072 (sleep-for 0.1)
1073 (setq ret (process-exit-status p))))
1074 (delete-region (point-min) (point-max))
1075 (widen))
1076
1077 ;; When the user did interrupt, we should do it also. We use
1078 ;; return code -1 as marker.
1079 (quit
1080 (setq ret -1))
1081 ;; Handle errors.
1082 (error
1083 (setq ret 1)))
1084
1085 ;; We should show the output anyway.
1086 (when (and outbuf display) (display-buffer outbuf))
1087
1088 ;; Cleanup. We remove all file cache values for the connection,
1089 ;; because the remote process could have changed them.
1090 (tramp-set-connection-property v "process-name" nil)
1091 (tramp-set-connection-property v "process-buffer" nil)
1092 (when tmpinput (delete-file tmpinput))
1093 (unless outbuf
1094 (kill-buffer (tramp-get-connection-property v "process-buffer" nil)))
1095
1096 ;; `process-file-side-effects' has been introduced with GNU
1097 ;; Emacs 23.2. If set to `nil', no remote file will be changed
1098 ;; by `program'. If it doesn't exist, we assume its default
1099 ;; value `t'.
1100 (unless (and (boundp 'process-file-side-effects)
1101 (not (symbol-value 'process-file-side-effects)))
1102 (tramp-flush-directory-property v ""))
1103
1104 ;; Return exit status.
1105 (if (equal ret -1)
1106 (keyboard-quit)
1107 ret))))
1108
848(defun tramp-smb-handle-rename-file 1109(defun tramp-smb-handle-rename-file
849 (filename newname &optional ok-if-already-exists) 1110 (filename newname &optional ok-if-already-exists)
850 "Like `rename-file' for Tramp files." 1111 "Like `rename-file' for Tramp files."
851 (setq filename (expand-file-name filename) 1112 (setq filename (expand-file-name filename)
852 newname (expand-file-name newname)) 1113 newname (expand-file-name newname))
1114
1115 (when (and (not ok-if-already-exists)
1116 (file-exists-p newname))
1117 (tramp-error
1118 (tramp-dissect-file-name
1119 (if (file-remote-p filename) filename newname))
1120 'file-already-exists newname))
1121
853 (tramp-with-progress-reporter 1122 (tramp-with-progress-reporter
854 (tramp-dissect-file-name (if (file-remote-p filename) filename newname)) 1123 (tramp-dissect-file-name (if (file-remote-p filename) filename newname))
855 0 (format "Renaming %s to %s" filename newname) 1124 0 (format "Renaming %s to %s" filename newname)
856 1125
857 (let ((tmpfile (file-local-copy filename))) 1126 (if (and (tramp-equal-remote filename newname)
858 1127 (string-equal
859 (if tmpfile 1128 (tramp-smb-get-share (tramp-dissect-file-name filename))
860 ;; Remote filename. 1129 (tramp-smb-get-share (tramp-dissect-file-name newname))))
861 (condition-case err 1130 ;; We can rename directly.
862 (rename-file tmpfile newname ok-if-already-exists) 1131 (with-parsed-tramp-file-name filename v1
863 ((error quit) 1132 (with-parsed-tramp-file-name newname v2
864 (delete-file tmpfile) 1133
865 (signal (car err) (cdr err)))) 1134 ;; We must also flush the cache of the directory, because
866 1135 ;; `file-attributes' reads the values from there.
867 ;; Remote newname. 1136 (tramp-flush-file-property v2 (file-name-directory v2-localname))
868 (when (file-directory-p newname) 1137 (tramp-flush-file-property v2 v2-localname)
869 (setq newname (expand-file-name 1138 (unless (tramp-smb-get-share v2)
870 (file-name-nondirectory filename) newname))) 1139 (tramp-error
871 1140 v2 'file-error "Target `%s' must contain a share name" newname))
872 (with-parsed-tramp-file-name newname nil 1141 (unless (tramp-smb-send-command
873 (when (and (not ok-if-already-exists) 1142 v2 (format "rename \"%s\" \"%s\""
874 (file-exists-p newname)) 1143 (tramp-smb-get-localname v1)
875 (tramp-error v 'file-already-exists newname)) 1144 (tramp-smb-get-localname v2)))
876 ;; We must also flush the cache of the directory, because 1145 (tramp-error v2 'file-error "Cannot rename `%s'" filename))))
877 ;; `file-attributes' reads the values from there.
878 (tramp-flush-file-property v (file-name-directory localname))
879 (tramp-flush-file-property v localname)
880 (unless (tramp-smb-send-command
881 v (format "put %s \"%s\""
882 filename (tramp-smb-get-localname v)))
883 (tramp-error v 'file-error "Cannot rename `%s'" filename)))))
884 1146
885 (delete-file filename))) 1147 ;; We must rename via copy.
1148 (tramp-compat-copy-file filename newname ok-if-already-exists t t t)
1149 (if (file-directory-p filename)
1150 (tramp-compat-delete-directory filename 'recursive)
1151 (delete-file filename)))))
886 1152
887(defun tramp-smb-handle-set-file-modes (filename mode) 1153(defun tramp-smb-handle-set-file-modes (filename mode)
888 "Like `set-file-modes' for Tramp files." 1154 "Like `set-file-modes' for Tramp files."
@@ -896,6 +1162,54 @@ target of the symlink differ."
896 (tramp-error 1162 (tramp-error
897 v 'file-error "Error while changing file's mode %s" filename))))) 1163 v 'file-error "Error while changing file's mode %s" filename)))))
898 1164
1165;; We use BUFFER also as connection buffer during setup. Because of
1166;; this, its original contents must be saved, and restored once
1167;; connection has been setup.
1168(defun tramp-smb-handle-start-file-process (name buffer program &rest args)
1169 "Like `start-file-process' for Tramp files."
1170 (with-parsed-tramp-file-name default-directory nil
1171 (let ((command (mapconcat 'identity (cons program args) " "))
1172 (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
1173 (name1 name)
1174 (i 0))
1175 (unwind-protect
1176 (save-excursion
1177 (save-restriction
1178 (unless buffer
1179 ;; BUFFER can be nil. We use a temporary buffer.
1180 (setq buffer (generate-new-buffer tramp-temp-buffer-name)))
1181 (while (get-process name1)
1182 ;; NAME must be unique as process name.
1183 (setq i (1+ i)
1184 name1 (format "%s<%d>" name i)))
1185 ;; Set the new process properties.
1186 (tramp-set-connection-property v "process-name" name1)
1187 (tramp-set-connection-property v "process-buffer" buffer)
1188 ;; Activate narrowing in order to save BUFFER contents.
1189 (with-current-buffer (tramp-get-connection-buffer v)
1190 (let ((buffer-undo-list t))
1191 (narrow-to-region (point-max) (point-max))
1192 (tramp-smb-call-winexe v)
1193 (when (tramp-smb-get-share v)
1194 (tramp-smb-send-command
1195 v (format
1196 "cd \"//%s%s\""
1197 host (file-name-directory localname))))
1198 (tramp-message v 6 "(%s); exit" command)
1199 (tramp-send-string v command)))
1200 ;; Return value.
1201 (tramp-get-connection-process v)))
1202
1203 ;; Save exit.
1204 (with-current-buffer (tramp-get-connection-buffer v)
1205 (if (string-match tramp-temp-buffer-name (buffer-name))
1206 (progn
1207 (set-process-buffer (tramp-get-connection-process v) nil)
1208 (kill-buffer (current-buffer)))
1209 (set-buffer-modified-p bmp)))
1210 (tramp-set-connection-property v "process-name" nil)
1211 (tramp-set-connection-property v "process-buffer" nil)))))
1212
899(defun tramp-smb-handle-substitute-in-file-name (filename) 1213(defun tramp-smb-handle-substitute-in-file-name (filename)
900 "Like `handle-substitute-in-file-name' for Tramp files. 1214 "Like `handle-substitute-in-file-name' for Tramp files.
901\"//\" substitutes only in the local filename part. Catches 1215\"//\" substitutes only in the local filename part. Catches
@@ -999,7 +1313,7 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
999 (with-parsed-tramp-file-name (file-name-as-directory directory) nil 1313 (with-parsed-tramp-file-name (file-name-as-directory directory) nil
1000 (setq localname (or localname "/")) 1314 (setq localname (or localname "/"))
1001 (with-file-property v localname "file-entries" 1315 (with-file-property v localname "file-entries"
1002 (with-current-buffer (tramp-get-buffer v) 1316 (with-current-buffer (tramp-get-connection-buffer v)
1003 (let* ((share (tramp-smb-get-share v)) 1317 (let* ((share (tramp-smb-get-share v))
1004 (cache (tramp-get-connection-property v "share-cache" nil)) 1318 (cache (tramp-get-connection-property v "share-cache" nil))
1005 res entry) 1319 res entry)
@@ -1187,7 +1501,7 @@ Result is the list (LOCALNAME MODE SIZE MTIME)."
1187 (tramp-get-connection-process vec) "cifs-capabilities" 1501 (tramp-get-connection-process vec) "cifs-capabilities"
1188 (save-match-data 1502 (save-match-data
1189 (when (tramp-smb-send-command vec "posix") 1503 (when (tramp-smb-send-command vec "posix")
1190 (with-current-buffer (tramp-get-buffer vec) 1504 (with-current-buffer (tramp-get-connection-buffer vec)
1191 (goto-char (point-min)) 1505 (goto-char (point-min))
1192 (when 1506 (when
1193 (re-search-forward "Server supports CIFS capabilities" nil t) 1507 (re-search-forward "Server supports CIFS capabilities" nil t)
@@ -1216,18 +1530,20 @@ Returns nil if there has been an error message from smbclient."
1216 (tramp-send-string vec command) 1530 (tramp-send-string vec command)
1217 (tramp-smb-wait-for-output vec)) 1531 (tramp-smb-wait-for-output vec))
1218 1532
1219(defun tramp-smb-maybe-open-connection (vec) 1533(defun tramp-smb-maybe-open-connection (vec &optional argument)
1220 "Maybe open a connection to HOST, log in as USER, using `tramp-smb-program'. 1534 "Maybe open a connection to HOST, log in as USER, using `tramp-smb-program'.
1221Does not do anything if a connection is already open, but re-opens the 1535Does not do anything if a connection is already open, but re-opens the
1222connection if a previous connection has died for some reason." 1536connection if a previous connection has died for some reason.
1537If ARGUMENT is non-nil, use it as argument for
1538`tramp-smb-winexe-program', and suppress any checks."
1223 (let* ((share (tramp-smb-get-share vec)) 1539 (let* ((share (tramp-smb-get-share vec))
1224 (buf (tramp-get-buffer vec)) 1540 (buf (tramp-get-connection-buffer vec))
1225 (p (get-buffer-process buf))) 1541 (p (get-buffer-process buf)))
1226 1542
1227 ;; Check whether we still have the same smbclient version. 1543 ;; Check whether we still have the same smbclient version.
1228 ;; Otherwise, we must delete the connection cache, because 1544 ;; Otherwise, we must delete the connection cache, because
1229 ;; capabilities migh have changed. 1545 ;; capabilities migh have changed.
1230 (unless (processp p) 1546 (unless (or argument (processp p))
1231 (let ((default-directory (tramp-compat-temporary-file-directory)) 1547 (let ((default-directory (tramp-compat-temporary-file-directory))
1232 (command (concat tramp-smb-program " -V"))) 1548 (command (concat tramp-smb-program " -V")))
1233 1549
@@ -1271,9 +1587,10 @@ connection if a previous connection has died for some reason."
1271 ;; Check whether it is still the same share. 1587 ;; Check whether it is still the same share.
1272 (unless 1588 (unless
1273 (and p (processp p) (memq (process-status p) '(run open)) 1589 (and p (processp p) (memq (process-status p) '(run open))
1274 (string-equal 1590 (or argument
1275 share 1591 (string-equal
1276 (tramp-get-connection-property p "smb-share" ""))) 1592 share
1593 (tramp-get-connection-property p "smb-share" ""))))
1277 1594
1278 (save-match-data 1595 (save-match-data
1279 ;; There might be unread output from checking for share names. 1596 ;; There might be unread output from checking for share names.
@@ -1288,9 +1605,13 @@ connection if a previous connection has died for some reason."
1288 (port (tramp-file-name-port vec)) 1605 (port (tramp-file-name-port vec))
1289 args) 1606 args)
1290 1607
1291 (if share 1608 (cond
1292 (setq args (list (concat "//" real-host "/" share))) 1609 (argument
1293 (setq args (list "-g" "-L" real-host ))) 1610 (setq args (list (concat "//" real-host))))
1611 (share
1612 (setq args (list (concat "//" real-host "/" share))))
1613 (t
1614 (setq args (list "-g" "-L" real-host ))))
1294 1615
1295 (if (not (zerop (length real-user))) 1616 (if (not (zerop (length real-user)))
1296 (setq args (append args (list "-U" real-user))) 1617 (setq args (append args (list "-U" real-user)))
@@ -1300,6 +1621,8 @@ connection if a previous connection has died for some reason."
1300 (when port (setq args (append args (list "-p" port)))) 1621 (when port (setq args (append args (list "-p" port))))
1301 (when tramp-smb-conf 1622 (when tramp-smb-conf
1302 (setq args (append args (list "-s" tramp-smb-conf)))) 1623 (setq args (append args (list "-s" tramp-smb-conf))))
1624 (when argument
1625 (setq args (append args (list argument))))
1303 1626
1304 ;; OK, let's go. 1627 ;; OK, let's go.
1305 (tramp-with-progress-reporter 1628 (tramp-with-progress-reporter
@@ -1313,8 +1636,11 @@ connection if a previous connection has died for some reason."
1313 (p (let ((default-directory 1636 (p (let ((default-directory
1314 (tramp-compat-temporary-file-directory))) 1637 (tramp-compat-temporary-file-directory)))
1315 (apply #'start-process 1638 (apply #'start-process
1316 (tramp-buffer-name vec) (tramp-get-buffer vec) 1639 (tramp-get-connection-name vec)
1317 tramp-smb-program args)))) 1640 (tramp-get-connection-buffer vec)
1641 (if argument
1642 tramp-smb-winexe-program tramp-smb-program)
1643 args))))
1318 1644
1319 (tramp-message 1645 (tramp-message
1320 vec 6 "%s" (mapconcat 'identity (process-command p) " ")) 1646 vec 6 "%s" (mapconcat 'identity (process-command p) " "))
@@ -1325,40 +1651,58 @@ connection if a previous connection has died for some reason."
1325 tramp-current-user user 1651 tramp-current-user user
1326 tramp-current-host host) 1652 tramp-current-host host)
1327 1653
1328 ;; Play login scenario. 1654 (condition-case err
1329 (tramp-process-actions 1655 (let (tramp-message-show-message)
1330 p vec nil 1656 ;; Play login scenario.
1331 (if share 1657 (tramp-process-actions
1332 tramp-smb-actions-with-share 1658 p vec nil
1333 tramp-smb-actions-without-share)) 1659 (if (or argument share)
1334 1660 tramp-smb-actions-with-share
1335 ;; Check server version. 1661 tramp-smb-actions-without-share))
1336 (with-current-buffer (tramp-get-connection-buffer vec) 1662
1337 (goto-char (point-min)) 1663 ;; Check server version.
1338 (search-forward-regexp 1664 (unless argument
1339 "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]" nil t) 1665 (with-current-buffer (tramp-get-connection-buffer vec)
1340 (let ((smbserver-version (match-string 0))) 1666 (goto-char (point-min))
1341 (unless 1667 (search-forward-regexp tramp-smb-server-version nil t)
1342 (string-equal 1668 (let ((smbserver-version (match-string 0)))
1343 smbserver-version 1669 (unless
1344 (tramp-get-connection-property 1670 (string-equal
1345 vec "smbserver-version" smbserver-version)) 1671 smbserver-version
1346 (tramp-flush-directory-property vec "") 1672 (tramp-get-connection-property
1347 (tramp-flush-connection-property vec)) 1673 vec "smbserver-version" smbserver-version))
1348 (tramp-set-connection-property 1674 (tramp-flush-directory-property vec "")
1349 vec "smbserver-version" smbserver-version))) 1675 (tramp-flush-connection-property vec))
1350 1676 (tramp-set-connection-property
1351 ;; Set chunksize. Otherwise, `tramp-send-string' might 1677 vec "smbserver-version" smbserver-version))))
1352 ;; try it itself. 1678
1353 (tramp-set-connection-property p "smb-share" share) 1679 ;; Set chunksize. Otherwise, `tramp-send-string' might
1354 (tramp-set-connection-property 1680 ;; try it itself.
1355 p "chunksize" tramp-chunksize)))))))) 1681 (tramp-set-connection-property p "smb-share" share)
1682 (tramp-set-connection-property
1683 p "chunksize" tramp-chunksize))
1684
1685 ;; Check for the error reason. If it was due to wrong
1686 ;; password, reestablish the connection. We cannot
1687 ;; handle this in `tramp-process-actions', because
1688 ;; smbclient does not ask for the password, again.
1689 (error
1690 (with-current-buffer (tramp-get-connection-buffer vec)
1691 (goto-char (point-min))
1692 (if (search-forward-regexp
1693 tramp-smb-wrong-passwd-regexp nil t)
1694 ;; Disable `auth-source' and `password-cache'.
1695 (let (auth-sources)
1696 (tramp-cleanup vec)
1697 (tramp-smb-maybe-open-connection vec argument))
1698 ;; Propagate the error.
1699 (signal (car err) (cdr err)))))))))))))
1356 1700
1357;; We don't use timeouts. If needed, the caller shall wrap around. 1701;; We don't use timeouts. If needed, the caller shall wrap around.
1358(defun tramp-smb-wait-for-output (vec) 1702(defun tramp-smb-wait-for-output (vec)
1359 "Wait for output from smbclient command. 1703 "Wait for output from smbclient command.
1360Returns nil if an error message has appeared." 1704Returns nil if an error message has appeared."
1361 (with-current-buffer (tramp-get-buffer vec) 1705 (with-current-buffer (tramp-get-connection-buffer vec)
1362 (let ((p (get-buffer-process (current-buffer))) 1706 (let ((p (get-buffer-process (current-buffer)))
1363 (found (progn (goto-char (point-min)) 1707 (found (progn (goto-char (point-min))
1364 (re-search-forward tramp-smb-prompt nil t))) 1708 (re-search-forward tramp-smb-prompt nil t)))
@@ -1392,10 +1736,68 @@ Returns nil if an error message has appeared."
1392 (goto-char (point-min)) 1736 (goto-char (point-min))
1393 (setq found (re-search-forward tramp-smb-prompt nil t))) 1737 (setq found (re-search-forward tramp-smb-prompt nil t)))
1394 1738
1395 ;; Return value is whether no error message has appeared.
1396 (tramp-message vec 6 "\n%s" (buffer-string)) 1739 (tramp-message vec 6 "\n%s" (buffer-string))
1740
1741 ;; Remove prompt.
1742 (when found
1743 (goto-char (point-max))
1744 (re-search-backward tramp-smb-prompt nil t)
1745 (delete-region (point) (point-max)))
1746
1747 ;; Return value is whether no error message has appeared.
1397 (not err)))) 1748 (not err))))
1398 1749
1750(defun tramp-smb-kill-winexe-function ()
1751 "Send SIGKILL to the winexe process."
1752 (ignore-errors
1753 (let ((p (get-buffer-process (current-buffer))))
1754 (when (and p (processp p) (memq (process-status p) '(run open)))
1755 (signal-process (process-id p) 'SIGINT)))))
1756
1757(defun tramp-smb-call-winexe (vec)
1758 "Apply a remote command, if possible, using `tramp-smb-winexe-program'."
1759
1760 ;; We call `tramp-get-buffer' in order to get a debug buffer for
1761 ;; messages.
1762 (tramp-get-buffer vec)
1763
1764 ;; Check for program.
1765 (unless (let ((default-directory
1766 (tramp-compat-temporary-file-directory)))
1767 (executable-find tramp-smb-winexe-program))
1768 (tramp-error
1769 vec 'file-error "Cannot find program: %s" tramp-smb-winexe-program))
1770
1771 ;; winexe does not supports ports.
1772 (when (tramp-file-name-port vec)
1773 (tramp-error vec 'file-error "Port not supported for remote processes"))
1774
1775 (tramp-smb-maybe-open-connection
1776 vec
1777 (format
1778 "%s %s"
1779 tramp-smb-winexe-shell-command tramp-smb-winexe-shell-command-switch))
1780
1781 (set (make-local-variable 'kill-buffer-hook)
1782 '(tramp-smb-kill-winexe-function))
1783
1784 ;; Suppress "^M". Shouldn't we specify utf8?
1785 (set-process-coding-system (tramp-get-connection-process vec) 'raw-text-dos)
1786
1787 ;; Set width to 128. This avoids mixing prompt and long error messages.
1788 (tramp-smb-send-command vec "$rawui = (Get-Host).UI.RawUI")
1789 (tramp-smb-send-command vec "$bufsize = $rawui.BufferSize")
1790 (tramp-smb-send-command vec "$winsize = $rawui.WindowSize")
1791 (tramp-smb-send-command vec "$bufsize.Width = 128")
1792 (tramp-smb-send-command vec "$winsize.Width = 128")
1793 (tramp-smb-send-command vec "$rawui.BufferSize = $bufsize")
1794 (tramp-smb-send-command vec "$rawui.WindowSize = $winsize"))
1795
1796(defun tramp-smb-shell-quote-argument (s)
1797 "Similar to `shell-quote-argument', but uses windows cmd syntax."
1798 (let ((system-type 'ms-dos))
1799 (shell-quote-argument s)))
1800
1399(add-hook 'tramp-unload-hook 1801(add-hook 'tramp-unload-hook
1400 (lambda () 1802 (lambda ()
1401 (unload-feature 'tramp-smb 'force))) 1803 (unload-feature 'tramp-smb 'force)))
@@ -1404,12 +1806,9 @@ Returns nil if an error message has appeared."
1404 1806
1405;;; TODO: 1807;;; TODO:
1406 1808
1407;; * Error handling in case password is wrong.
1408;; * Return more comprehensive file permission string. 1809;; * Return more comprehensive file permission string.
1409;; * Try to remove the inclusion of dummy "" directory. Seems to be at 1810;; * Try to remove the inclusion of dummy "" directory. Seems to be at
1410;; several places, especially in `tramp-smb-handle-insert-directory'. 1811;; several places, especially in `tramp-smb-handle-insert-directory'.
1411;; * (RMS) Use unwind-protect to clean up the state so as to make the state
1412;; regular again.
1413;; * Ignore case in file names. 1812;; * Ignore case in file names.
1414 1813
1415;;; tramp-smb.el ends here 1814;;; tramp-smb.el ends here
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index be5bfdb79da..f34818c2e02 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -57,6 +57,7 @@
57 57
58;;; Code: 58;;; Code:
59 59
60(eval-when-compile (require 'cl)) ; ignore-errors
60(require 'tramp-compat) 61(require 'tramp-compat)
61 62
62;;; User Customizable Internal Variables: 63;;; User Customizable Internal Variables:
@@ -116,7 +117,7 @@ policy for local files."
116(eval-and-compile 117(eval-and-compile
117 (when (featurep 'xemacs) 118 (when (featurep 'xemacs)
118 (defcustom tramp-bkup-backup-directory-info nil 119 (defcustom tramp-bkup-backup-directory-info nil
119 "*Alist of (FILE-REGEXP BACKUP-DIR OPTIONS ...)) 120 "Alist of (FILE-REGEXP BACKUP-DIR OPTIONS ...))
120It has the same meaning like `bkup-backup-directory-info' from package 121It has the same meaning like `bkup-backup-directory-info' from package
121`backup-dir'. If a Tramp file is backed up, and BACKUP-DIR is a local 122`backup-dir'. If a Tramp file is backed up, and BACKUP-DIR is a local
122file name, the backup directory is prepended with Tramp file name prefix 123file name, the backup directory is prepended with Tramp file name prefix
@@ -247,15 +248,6 @@ pair of the form (KEY VALUE). The following KEYs are defined:
247 * `tramp-gw-args' 248 * `tramp-gw-args'
248 As the attribute name says, additional arguments are specified here 249 As the attribute name says, additional arguments are specified here
249 when a method is applied via a gateway. 250 when a method is applied via a gateway.
250 * `tramp-password-end-of-line'
251 This specifies the string to use for terminating the line after
252 submitting the password. If this method parameter is nil, then the
253 value of the normal variable `tramp-default-password-end-of-line'
254 is used. This parameter is necessary because the \"plink\" program
255 requires any two characters after sending the password. These do
256 not have to be newline or carriage return characters. Other login
257 programs are happy with just one character, the newline character.
258 We use \"xy\" as the value for methods using \"plink\".
259 * `tramp-tmpdir' 251 * `tramp-tmpdir'
260 A directory on the remote host for temporary files. If not 252 A directory on the remote host for temporary files. If not
261 specified, \"/tmp\" is taken as default. 253 specified, \"/tmp\" is taken as default.
@@ -408,6 +400,11 @@ interpreted as a regular expression which always matches."
408 (choice :tag "User regexp" regexp sexp) 400 (choice :tag "User regexp" regexp sexp)
409 (choice :tag " Proxy name" string (const nil))))) 401 (choice :tag " Proxy name" string (const nil)))))
410 402
403(defcustom tramp-save-ad-hoc-proxies nil
404 "Whether to save ad-hoc proxies persistently."
405 :group 'tramp
406 :type 'boolean)
407
411;;;###tramp-autoload 408;;;###tramp-autoload
412(defconst tramp-local-host-regexp 409(defconst tramp-local-host-regexp
413 (concat 410 (concat
@@ -432,7 +429,7 @@ names from FILE for completion. The following predefined FUNCTIONs exists:
432 * `tramp-parse-hosts' for \"/etc/hosts\" like files, 429 * `tramp-parse-hosts' for \"/etc/hosts\" like files,
433 * `tramp-parse-passwd' for \"/etc/passwd\" like files. 430 * `tramp-parse-passwd' for \"/etc/passwd\" like files.
434 * `tramp-parse-netrc' for \"~/.netrc\" like files. 431 * `tramp-parse-netrc' for \"~/.netrc\" like files.
435 * `tramp-parse-putty' for PuTTY registry keys. 432 * `tramp-parse-putty' for PuTTY registered sessions.
436 433
437FUNCTION can also be a customer defined function. For more details see 434FUNCTION can also be a customer defined function. For more details see
438the info pages.") 435the info pages.")
@@ -471,24 +468,7 @@ the remote shell.")
471(defcustom tramp-rsh-end-of-line "\n" 468(defcustom tramp-rsh-end-of-line "\n"
472 "String used for end of line in rsh connections. 469 "String used for end of line in rsh connections.
473I don't think this ever needs to be changed, so please tell me about it 470I don't think this ever needs to be changed, so please tell me about it
474if you need to change this. 471if you need to change this."
475Also see the method parameter `tramp-password-end-of-line' and the normal
476variable `tramp-default-password-end-of-line'."
477 :group 'tramp
478 :type 'string)
479
480(defcustom tramp-default-password-end-of-line
481 tramp-rsh-end-of-line
482 "String used for end of line after sending a password.
483This variable provides the default value for the method parameter
484`tramp-password-end-of-line', see `tramp-methods' for more details.
485
486It seems that people using plink under Windows need to send
487\"\\r\\n\" (carriage-return, then newline) after a password, but just
488\"\\n\" after all other lines. This variable can be used for the
489password, see `tramp-rsh-end-of-line' for the other cases.
490
491The default value is to use the same value as `tramp-rsh-end-of-line'."
492 :group 'tramp 472 :group 'tramp
493 :type 'string) 473 :type 'string)
494 474
@@ -505,8 +485,10 @@ Sometimes the prompt is reported to look like \"login as:\"."
505 ;; Allow a prompt to start right after a ^M since it indeed would be 485 ;; Allow a prompt to start right after a ^M since it indeed would be
506 ;; displayed at the beginning of the line (and Zsh uses it). This 486 ;; displayed at the beginning of the line (and Zsh uses it). This
507 ;; regexp works only for GNU Emacs. 487 ;; regexp works only for GNU Emacs.
488 ;; Allow also [] style prompts. They can appear only during
489 ;; connection initialization; Tramp redefines the prompt afterwards.
508 (concat (if (featurep 'xemacs) "" "\\(?:^\\|\r\\)") 490 (concat (if (featurep 'xemacs) "" "\\(?:^\\|\r\\)")
509 "[^#$%>\n]*#?[#$%>] *\\(\e\\[[0-9;]*[a-zA-Z] *\\)*") 491 "[^]#$%>\n]*#?[]#$%>] *\\(\e\\[[0-9;]*[a-zA-Z] *\\)*")
510 "Regexp to match prompts from remote shell. 492 "Regexp to match prompts from remote shell.
511Normally, Tramp expects you to configure `shell-prompt-pattern' 493Normally, Tramp expects you to configure `shell-prompt-pattern'
512correctly, but sometimes it happens that you are connecting to a 494correctly, but sometimes it happens that you are connecting to a
@@ -695,7 +677,7 @@ Used in `tramp-make-tramp-file-name'.")
695 "Regexp matching delimiter between method and user or host names. 677 "Regexp matching delimiter between method and user or host names.
696Derived from `tramp-postfix-method-format'.") 678Derived from `tramp-postfix-method-format'.")
697 679
698(defconst tramp-user-regexp "[^:/ \t]+" 680(defconst tramp-user-regexp "[^/|: \t]+"
699 "Regexp matching user names.") 681 "Regexp matching user names.")
700 682
701;;;###tramp-autoload 683;;;###tramp-autoload
@@ -783,6 +765,14 @@ Derived from `tramp-prefix-port-format'.")
783 "\\(" tramp-port-regexp "\\)") 765 "\\(" tramp-port-regexp "\\)")
784 "Regexp matching host names with port numbers.") 766 "Regexp matching host names with port numbers.")
785 767
768(defconst tramp-postfix-hop-format "|"
769 "String matching delimiter after ad-hoc hop definitions.")
770
771(defconst tramp-postfix-hop-regexp
772 (regexp-quote tramp-postfix-hop-format)
773 "Regexp matching delimiter after ad-hoc hop definitions.
774Derived from `tramp-postfix-hop-format'.")
775
786(defconst tramp-postfix-host-format 776(defconst tramp-postfix-host-format
787 (cond ((equal tramp-syntax 'ftp) ":") 777 (cond ((equal tramp-syntax 'ftp) ":")
788 ((equal tramp-syntax 'sep) "]") 778 ((equal tramp-syntax 'sep) "]")
@@ -801,22 +791,26 @@ Derived from `tramp-postfix-host-format'.")
801 791
802;;; File name format: 792;;; File name format:
803 793
794(defconst tramp-remote-file-name-spec-regexp
795 (concat
796 "\\(?:" "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp "\\)?"
797 "\\(?:" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?"
798 "\\(" "\\(?:" tramp-host-regexp "\\|"
799 tramp-prefix-ipv6-regexp tramp-ipv6-regexp
800 tramp-postfix-ipv6-regexp "\\)"
801 "\\(?:" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?")
802"Regular expression matching a Tramp file name between prefix and postfix.")
803
804(defconst tramp-file-name-structure 804(defconst tramp-file-name-structure
805 (list 805 (list
806 (concat 806 (concat
807 tramp-prefix-regexp 807 tramp-prefix-regexp
808 "\\(" "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp "\\)?" 808 "\\(" "\\(?:" tramp-remote-file-name-spec-regexp
809 "\\(" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?" 809 tramp-postfix-hop-regexp "\\)+" "\\)?"
810 "\\(" "\\(" tramp-host-regexp 810 tramp-remote-file-name-spec-regexp tramp-postfix-host-regexp
811 "\\|"
812 tramp-prefix-ipv6-regexp tramp-ipv6-regexp
813 tramp-postfix-ipv6-regexp "\\)"
814 "\\(" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?"
815 tramp-postfix-host-regexp
816 "\\(" tramp-localname-regexp "\\)") 811 "\\(" tramp-localname-regexp "\\)")
817 2 4 5 8) 812 5 6 7 8 1)
818 813 "List of six elements (REGEXP METHOD USER HOST FILE HOP), detailing \
819 "List of five elements (REGEXP METHOD USER HOST FILE), detailing \
820the Tramp file name structure. 814the Tramp file name structure.
821 815
822The first element REGEXP is a regular expression matching a Tramp file 816The first element REGEXP is a regular expression matching a Tramp file
@@ -827,6 +821,9 @@ The second element METHOD is a number, saying which pair of
827parentheses matches the method name. The third element USER is 821parentheses matches the method name. The third element USER is
828similar, but for the user name. The fourth element HOST is similar, 822similar, but for the user name. The fourth element HOST is similar,
829but for the host name. The fifth element FILE is for the file name. 823but for the host name. The fifth element FILE is for the file name.
824The last element HOP is the ad-hoc hop definition, which could be a
825cascade of several hops.
826
830These numbers are passed directly to `match-string', which see. That 827These numbers are passed directly to `match-string', which see. That
831means the opening parentheses are counted to identify the pair. 828means the opening parentheses are counted to identify the pair.
832 829
@@ -835,8 +832,8 @@ See also `tramp-file-name-regexp'.")
835;;;###autoload 832;;;###autoload
836(defconst tramp-file-name-regexp-unified 833(defconst tramp-file-name-regexp-unified
837 (if (memq system-type '(cygwin windows-nt)) 834 (if (memq system-type '(cygwin windows-nt))
838 "\\`/\\([^[/:]\\{2,\\}\\|[^/]\\{2,\\}]\\):" 835 "\\`/\\([^[/|:]\\{2,\\}\\|[^/|]\\{2,\\}]\\):"
839 "\\`/\\([^[/:]+\\|[^/]+]\\):") 836 "\\`/\\([^[/|:]+\\|[^/|]+]\\):")
840 "Value for `tramp-file-name-regexp' for unified remoting. 837 "Value for `tramp-file-name-regexp' for unified remoting.
841Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and 838Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and
842Tramp. See `tramp-file-name-structure' for more explanations. 839Tramp. See `tramp-file-name-structure' for more explanations.
@@ -850,7 +847,7 @@ XEmacs uses a separate filename syntax for Tramp and EFS.
850See `tramp-file-name-structure' for more explanations.") 847See `tramp-file-name-structure' for more explanations.")
851 848
852;;;###autoload 849;;;###autoload
853(defconst tramp-file-name-regexp-url "\\`/[^/:]+://" 850(defconst tramp-file-name-regexp-url "\\`/[^/|:]+://"
854 "Value for `tramp-file-name-regexp' for URL-like remoting. 851 "Value for `tramp-file-name-regexp' for URL-like remoting.
855See `tramp-file-name-structure' for more explanations.") 852See `tramp-file-name-structure' for more explanations.")
856 853
@@ -1041,9 +1038,15 @@ calling HANDLER.")
1041;; internal data structure. Convenience functions for internal 1038;; internal data structure. Convenience functions for internal
1042;; data structure. 1039;; data structure.
1043 1040
1041(defun tramp-get-method-parameter (method param)
1042 "Return the method parameter PARAM.
1043If the `tramp-methods' entry does not exist, return nil."
1044 (let ((entry (assoc param (assoc method tramp-methods))))
1045 (when entry (cadr entry))))
1046
1044(defun tramp-file-name-p (vec) 1047(defun tramp-file-name-p (vec)
1045 "Check, whether VEC is a Tramp object." 1048 "Check, whether VEC is a Tramp object."
1046 (and (vectorp vec) (= 4 (length vec)))) 1049 (and (vectorp vec) (= 5 (length vec))))
1047 1050
1048(defun tramp-file-name-method (vec) 1051(defun tramp-file-name-method (vec)
1049 "Return method component of VEC." 1052 "Return method component of VEC."
@@ -1061,6 +1064,10 @@ calling HANDLER.")
1061 "Return localname component of VEC." 1064 "Return localname component of VEC."
1062 (and (tramp-file-name-p vec) (aref vec 3))) 1065 (and (tramp-file-name-p vec) (aref vec 3)))
1063 1066
1067(defun tramp-file-name-hop (vec)
1068 "Return hop component of VEC."
1069 (and (tramp-file-name-p vec) (aref vec 4)))
1070
1064;; The user part of a Tramp file name vector can be of kind 1071;; The user part of a Tramp file name vector can be of kind
1065;; "user%domain". Sometimes, we must extract these parts. 1072;; "user%domain". Sometimes, we must extract these parts.
1066(defun tramp-file-name-real-user (vec) 1073(defun tramp-file-name-real-user (vec)
@@ -1157,19 +1164,20 @@ values."
1157 (let ((method (match-string (nth 1 tramp-file-name-structure) name)) 1164 (let ((method (match-string (nth 1 tramp-file-name-structure) name))
1158 (user (match-string (nth 2 tramp-file-name-structure) name)) 1165 (user (match-string (nth 2 tramp-file-name-structure) name))
1159 (host (match-string (nth 3 tramp-file-name-structure) name)) 1166 (host (match-string (nth 3 tramp-file-name-structure) name))
1160 (localname (match-string (nth 4 tramp-file-name-structure) name))) 1167 (localname (match-string (nth 4 tramp-file-name-structure) name))
1168 (hop (match-string (nth 5 tramp-file-name-structure) name)))
1161 (when host 1169 (when host
1162 (when (string-match tramp-prefix-ipv6-regexp host) 1170 (when (string-match tramp-prefix-ipv6-regexp host)
1163 (setq host (replace-match "" nil t host))) 1171 (setq host (replace-match "" nil t host)))
1164 (when (string-match tramp-postfix-ipv6-regexp host) 1172 (when (string-match tramp-postfix-ipv6-regexp host)
1165 (setq host (replace-match "" nil t host)))) 1173 (setq host (replace-match "" nil t host))))
1166 (if nodefault 1174 (if nodefault
1167 (vector method user host localname) 1175 (vector method user host localname hop)
1168 (vector 1176 (vector
1169 (tramp-find-method method user host) 1177 (tramp-find-method method user host)
1170 (tramp-find-user method user host) 1178 (tramp-find-user method user host)
1171 (tramp-find-host method user host) 1179 (tramp-find-host method user host)
1172 localname)))))) 1180 localname hop))))))
1173 1181
1174(defun tramp-buffer-name (vec) 1182(defun tramp-buffer-name (vec)
1175 "A name for the connection buffer VEC." 1183 "A name for the connection buffer VEC."
@@ -1183,9 +1191,10 @@ values."
1183 (format "*tramp/%s %s@%s*" method user host) 1191 (format "*tramp/%s %s@%s*" method user host)
1184 (format "*tramp/%s %s*" method host)))) 1192 (format "*tramp/%s %s*" method host))))
1185 1193
1186(defun tramp-make-tramp-file-name (method user host localname) 1194(defun tramp-make-tramp-file-name (method user host localname &optional hop)
1187 "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME." 1195 "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME.
1188 (concat tramp-prefix-format 1196When not nil, an optional HOP is prepended."
1197 (concat tramp-prefix-format hop
1189 (when (not (zerop (length method))) 1198 (when (not (zerop (length method)))
1190 (concat method tramp-postfix-method-format)) 1199 (concat method tramp-postfix-method-format))
1191 (when (not (zerop (length user))) 1200 (when (not (zerop (length user)))
@@ -1357,6 +1366,10 @@ ARGS to actually emit the message (if applicable)."
1357This variable is used to disable messages from `tramp-error'. 1366This variable is used to disable messages from `tramp-error'.
1358The messages are visible anyway, because an error is raised.") 1367The messages are visible anyway, because an error is raised.")
1359 1368
1369(defvar tramp-message-show-progress-reporter-message t
1370 "Show Tramp progress reporter message in the minibuffer.
1371This variable is used to disable recurive progress reporter messages.")
1372
1360(defsubst tramp-message (vec-or-proc level fmt-string &rest args) 1373(defsubst tramp-message (vec-or-proc level fmt-string &rest args)
1361 "Emit a message depending on verbosity level. 1374 "Emit a message depending on verbosity level.
1362VEC-OR-PROC identifies the Tramp buffer to use. It can be either a 1375VEC-OR-PROC identifies the Tramp buffer to use. It can be either a
@@ -1422,13 +1435,14 @@ an input event arrives. The other arguments are passed to `tramp-error'."
1422 (unwind-protect 1435 (unwind-protect
1423 (apply 'tramp-error vec-or-proc signal fmt-string args) 1436 (apply 'tramp-error vec-or-proc signal fmt-string args)
1424 (when (and vec-or-proc 1437 (when (and vec-or-proc
1438 tramp-message-show-message
1425 (not (zerop tramp-verbose)) 1439 (not (zerop tramp-verbose))
1426 (not (tramp-completion-mode-p))) 1440 (not (tramp-completion-mode-p)))
1427 (let ((enable-recursive-minibuffers t)) 1441 (let ((enable-recursive-minibuffers t))
1428 (pop-to-buffer 1442 (pop-to-buffer
1429 (or (and (bufferp buffer) buffer) 1443 (or (and (bufferp buffer) buffer)
1430 (and (processp vec-or-proc) (process-buffer vec-or-proc)) 1444 (and (processp vec-or-proc) (process-buffer vec-or-proc))
1431 (tramp-get-buffer vec-or-proc))) 1445 (tramp-get-connection-buffer vec-or-proc)))
1432 (sit-for 30)))))) 1446 (sit-for 30))))))
1433 1447
1434(defmacro with-parsed-tramp-file-name (filename var &rest body) 1448(defmacro with-parsed-tramp-file-name (filename var &rest body)
@@ -1439,13 +1453,14 @@ Second arg VAR is a symbol. It is used as a variable name to hold
1439the filename structure. It is also used as a prefix for the variables 1453the filename structure. It is also used as a prefix for the variables
1440holding the components. For example, if VAR is the symbol `foo', then 1454holding the components. For example, if VAR is the symbol `foo', then
1441`foo' will be bound to the whole structure, `foo-method' will be bound to 1455`foo' will be bound to the whole structure, `foo-method' will be bound to
1442the method component, and so on for `foo-user', `foo-host', `foo-localname'. 1456the method component, and so on for `foo-user', `foo-host', `foo-localname',
1457`foo-hop'.
1443 1458
1444Remaining args are Lisp expressions to be evaluated (inside an implicit 1459Remaining args are Lisp expressions to be evaluated (inside an implicit
1445`progn'). 1460`progn').
1446 1461
1447If VAR is nil, then we bind `v' to the structure and `method', `user', 1462If VAR is nil, then we bind `v' to the structure and `method', `user',
1448`host', `localname' to the components." 1463`host', `localname', `hop' to the components."
1449 `(let* ((,(or var 'v) (tramp-dissect-file-name ,filename)) 1464 `(let* ((,(or var 'v) (tramp-dissect-file-name ,filename))
1450 (,(if var (intern (concat (symbol-name var) "-method")) 'method) 1465 (,(if var (intern (concat (symbol-name var) "-method")) 'method)
1451 (tramp-file-name-method ,(or var 'v))) 1466 (tramp-file-name-method ,(or var 'v)))
@@ -1454,7 +1469,9 @@ If VAR is nil, then we bind `v' to the structure and `method', `user',
1454 (,(if var (intern (concat (symbol-name var) "-host")) 'host) 1469 (,(if var (intern (concat (symbol-name var) "-host")) 'host)
1455 (tramp-file-name-host ,(or var 'v))) 1470 (tramp-file-name-host ,(or var 'v)))
1456 (,(if var (intern (concat (symbol-name var) "-localname")) 'localname) 1471 (,(if var (intern (concat (symbol-name var) "-localname")) 'localname)
1457 (tramp-file-name-localname ,(or var 'v)))) 1472 (tramp-file-name-localname ,(or var 'v)))
1473 (,(if var (intern (concat (symbol-name var) "-hop")) 'hop)
1474 (tramp-file-name-hop ,(or var 'v))))
1458 ,@body)) 1475 ,@body))
1459 1476
1460(put 'with-parsed-tramp-file-name 'lisp-indent-function 2) 1477(put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
@@ -1478,7 +1495,8 @@ progress reporter."
1478 (tramp-message ,vec ,level "%s..." ,message) 1495 (tramp-message ,vec ,level "%s..." ,message)
1479 ;; We start a pulsing progress reporter after 3 seconds. Feature 1496 ;; We start a pulsing progress reporter after 3 seconds. Feature
1480 ;; introduced in Emacs 24.1. 1497 ;; introduced in Emacs 24.1.
1481 (when (and tramp-message-show-message 1498 (when (and tramp-message-show-progress-reporter-message
1499 tramp-message-show-message
1482 ;; Display only when there is a minimum level. 1500 ;; Display only when there is a minimum level.
1483 (<= ,level (min tramp-verbose 3))) 1501 (<= ,level (min tramp-verbose 3)))
1484 (ignore-errors 1502 (ignore-errors
@@ -1486,11 +1504,10 @@ progress reporter."
1486 tm (when pr 1504 tm (when pr
1487 (run-at-time 3 0.1 'tramp-progress-reporter-update pr))))) 1505 (run-at-time 3 0.1 'tramp-progress-reporter-update pr)))))
1488 (unwind-protect 1506 (unwind-protect
1489 ;; Execute the body. Unset `tramp-message-show-message' when 1507 ;; Execute the body. Suppress concurrent progress reporter
1490 ;; the timer object is created, in order to suppress 1508 ;; messages.
1491 ;; concurrent timers. 1509 (let ((tramp-message-show-progress-reporter-message
1492 (let ((tramp-message-show-message 1510 (and tramp-message-show-progress-reporter-message (not tm))))
1493 (and tramp-message-show-message (not tm))))
1494 ,@body) 1511 ,@body)
1495 ;; Stop progress reporter. 1512 ;; Stop progress reporter.
1496 (if tm (tramp-compat-funcall 'cancel-timer tm)) 1513 (if tm (tramp-compat-funcall 'cancel-timer tm))
@@ -1514,6 +1531,19 @@ letter into the file name. This function removes it."
1514 1531
1515 'identity)) 1532 'identity))
1516 1533
1534(defun tramp-cleanup (vec)
1535 "Cleanup connection VEC, but keep the debug buffer."
1536 (with-current-buffer (tramp-get-debug-buffer vec)
1537 ;; Keep the debug buffer.
1538 (rename-buffer
1539 (generate-new-buffer-name tramp-temp-buffer-name) 'unique)
1540 (tramp-cleanup-connection vec)
1541 (if (= (point-min) (point-max))
1542 (kill-buffer nil)
1543 (rename-buffer (tramp-debug-buffer-name vec) 'unique))
1544 ;; We call `tramp-get-buffer' in order to keep the debug buffer.
1545 (tramp-get-buffer vec)))
1546
1517;;; Config Manipulation Functions: 1547;;; Config Manipulation Functions:
1518 1548
1519;;;###tramp-autoload 1549;;;###tramp-autoload
@@ -1522,9 +1552,7 @@ letter into the file name. This function removes it."
1522FUNCTION-LIST is a list of entries of the form (FUNCTION FILE). 1552FUNCTION-LIST is a list of entries of the form (FUNCTION FILE).
1523The FUNCTION is intended to parse FILE according its syntax. 1553The FUNCTION is intended to parse FILE according its syntax.
1524It might be a predefined FUNCTION, or a user defined FUNCTION. 1554It might be a predefined FUNCTION, or a user defined FUNCTION.
1525Predefined FUNCTIONs are `tramp-parse-rhosts', `tramp-parse-shosts', 1555For the list of predefined FUNCTIONs see `tramp-completion-function-alist'.
1526`tramp-parse-sconfig', `tramp-parse-hosts', `tramp-parse-passwd',
1527and `tramp-parse-netrc'.
1528 1556
1529Example: 1557Example:
1530 1558
@@ -1617,7 +1645,9 @@ been set up by `rfn-eshadow-setup-minibuffer'."
1617 (ignore-errors 1645 (ignore-errors
1618 (let ((end (or (tramp-compat-funcall 1646 (let ((end (or (tramp-compat-funcall
1619 'overlay-end (symbol-value 'rfn-eshadow-overlay)) 1647 'overlay-end (symbol-value 'rfn-eshadow-overlay))
1620 (tramp-compat-funcall 'minibuffer-prompt-end)))) 1648 (tramp-compat-funcall 'minibuffer-prompt-end)))
1649 ;; We do not want to send any remote command.
1650 (non-essential t))
1621 (when 1651 (when
1622 (file-remote-p 1652 (file-remote-p
1623 (tramp-compat-funcall 1653 (tramp-compat-funcall
@@ -1810,7 +1840,7 @@ ARGS are the arguments OPERATION has been called with."
1810 ;; Emacs 23+ only. 1840 ;; Emacs 23+ only.
1811 'copy-directory 1841 'copy-directory
1812 ;; Emacs 24+ only. 1842 ;; Emacs 24+ only.
1813 'file-equal-p 'file-in-directory-p 1843 'file-in-directory-p 'file-equal-p
1814 ;; XEmacs only. 1844 ;; XEmacs only.
1815 'dired-make-relative-symlink 1845 'dired-make-relative-symlink
1816 'vm-imap-move-mail 'vm-pop-move-mail 'vm-spool-move-mail)) 1846 'vm-imap-move-mail 'vm-pop-move-mail 'vm-spool-move-mail))
@@ -1886,8 +1916,9 @@ Falls back to normal file name handler if no Tramp file name handler exists."
1886 (with-parsed-tramp-file-name filename nil 1916 (with-parsed-tramp-file-name filename nil
1887 ;; Call the backend function. 1917 ;; Call the backend function.
1888 (if foreign 1918 (if foreign
1889 (condition-case err 1919 (tramp-compat-condition-case-unless-debug err
1890 (let ((sf (symbol-function foreign))) 1920 (let ((sf (symbol-function foreign))
1921 result)
1891 ;; Some packages set the default directory to a 1922 ;; Some packages set the default directory to a
1892 ;; remote path, before respective Tramp packages 1923 ;; remote path, before respective Tramp packages
1893 ;; are already loaded. This results in 1924 ;; are already loaded. This results in
@@ -1897,7 +1928,22 @@ Falls back to normal file name handler if no Tramp file name handler exists."
1897 (let ((default-directory 1928 (let ((default-directory
1898 (tramp-compat-temporary-file-directory))) 1929 (tramp-compat-temporary-file-directory)))
1899 (load (cadr sf) 'noerror 'nomessage))) 1930 (load (cadr sf) 'noerror 'nomessage)))
1900 (apply foreign operation args)) 1931 ;; If Tramp detects that it shouldn't continue
1932 ;; to work, it throws the `suppress' event. We
1933 ;; try the default handler then.
1934 ;; This could happen for example, when Tramp
1935 ;; tries to open the same connection twice in a
1936 ;; short time frame.
1937 (setq result
1938 (catch 'suppress (apply foreign operation args)))
1939 (if (eq result 'suppress)
1940 (let (tramp-message-show-message)
1941 (tramp-message
1942 v 1 "Suppress received in operation %s"
1943 (append (list operation) args))
1944 (tramp-cleanup v)
1945 (tramp-run-real-handler operation args))
1946 result))
1901 1947
1902 ;; Trace that somebody has interrupted the operation. 1948 ;; Trace that somebody has interrupted the operation.
1903 ((debug quit) 1949 ((debug quit)
@@ -1912,8 +1958,7 @@ Falls back to normal file name handler if no Tramp file name handler exists."
1912 ;; operations shall return at least a default value 1958 ;; operations shall return at least a default value
1913 ;; in order to give the user a chance to correct the 1959 ;; in order to give the user a chance to correct the
1914 ;; file name in the minibuffer. 1960 ;; file name in the minibuffer.
1915 ;; We cannot use `debug' as error handler. In order 1961 ;; In order to get a full backtrace, one could apply
1916 ;; to get a full backtrace, one could apply
1917 ;; (setq debug-on-error t debug-on-signal t) 1962 ;; (setq debug-on-error t debug-on-signal t)
1918 (error 1963 (error
1919 (cond 1964 (cond
@@ -2124,18 +2169,27 @@ not in completion mode."
2124(defun tramp-completion-handle-file-name-all-completions (filename directory) 2169(defun tramp-completion-handle-file-name-all-completions (filename directory)
2125 "Like `file-name-all-completions' for partial Tramp files." 2170 "Like `file-name-all-completions' for partial Tramp files."
2126 2171
2127 (let* ((fullname (tramp-drop-volume-letter 2172 (let ((fullname
2128 (expand-file-name filename directory))) 2173 (tramp-drop-volume-letter (expand-file-name filename directory)))
2129 ;; Possible completion structures. 2174 hop result result1)
2130 (v (tramp-completion-dissect-file-name fullname)) 2175
2131 result result1) 2176 ;; Suppress hop from completion.
2132 2177 (when (string-match
2133 (while v 2178 (concat
2134 (let* ((car (car v)) 2179 tramp-prefix-regexp
2135 (method (tramp-file-name-method car)) 2180 "\\(" "\\(" tramp-remote-file-name-spec-regexp
2136 (user (tramp-file-name-user car)) 2181 tramp-postfix-hop-regexp
2137 (host (tramp-file-name-host car)) 2182 "\\)+" "\\)")
2138 (localname (tramp-file-name-localname car)) 2183 fullname)
2184 (setq hop (match-string 1 fullname)
2185 fullname (replace-match "" nil nil fullname 1)))
2186
2187 ;; Possible completion structures.
2188 (dolist (elt (tramp-completion-dissect-file-name fullname))
2189 (let* ((method (tramp-file-name-method elt))
2190 (user (tramp-file-name-user elt))
2191 (host (tramp-file-name-host elt))
2192 (localname (tramp-file-name-localname elt))
2139 (m (tramp-find-method method user host)) 2193 (m (tramp-find-method method user host))
2140 (tramp-current-user user) ; see `tramp-parse-passwd' 2194 (tramp-current-user user) ; see `tramp-parse-passwd'
2141 all-user-hosts) 2195 all-user-hosts)
@@ -2163,18 +2217,16 @@ not in completion mode."
2163 2217
2164 ;; Possible methods. 2218 ;; Possible methods.
2165 (setq result 2219 (setq result
2166 (append result (tramp-get-completion-methods m))))) 2220 (append result (tramp-get-completion-methods m)))))))
2167
2168 (setq v (cdr v))))
2169 2221
2170 ;; Unify list, remove nil elements. 2222 ;; Unify list, add hop, remove nil elements.
2171 (while result 2223 (dolist (elt result)
2172 (let ((car (car result))) 2224 (when elt
2173 (when car 2225 (string-match tramp-prefix-regexp elt)
2174 (add-to-list 2226 (setq elt (replace-match (concat tramp-prefix-format hop) nil nil elt))
2175 'result1 2227 (add-to-list
2176 (substring car (length (tramp-drop-volume-letter directory))))) 2228 'result1
2177 (setq result (cdr result)))) 2229 (substring elt (length (tramp-drop-volume-letter directory))))))
2178 2230
2179 ;; Complete local parts. 2231 ;; Complete local parts.
2180 (append 2232 (append
@@ -2322,9 +2374,9 @@ They are collected by `tramp-completion-dissect-file-name1'."
2322 (concat tramp-prefix-regexp "/$")) 2374 (concat tramp-prefix-regexp "/$"))
2323 1 nil 3 nil))) 2375 1 nil 3 nil)))
2324 2376
2325 (mapc (lambda (regexp) 2377 (mapc (lambda (structure)
2326 (add-to-list 'result 2378 (add-to-list 'result
2327 (tramp-completion-dissect-file-name1 regexp name))) 2379 (tramp-completion-dissect-file-name1 structure name)))
2328 (list 2380 (list
2329 tramp-completion-file-name-structure1 2381 tramp-completion-file-name-structure1
2330 tramp-completion-file-name-structure2 2382 tramp-completion-file-name-structure2
@@ -2358,7 +2410,7 @@ remote host and localname (filename on remote host)."
2358 (match-string (nth 3 structure) name))) 2410 (match-string (nth 3 structure) name)))
2359 (localname (and (nth 4 structure) 2411 (localname (and (nth 4 structure)
2360 (match-string (nth 4 structure) name)))) 2412 (match-string (nth 4 structure) name))))
2361 (vector method user host localname))))) 2413 (vector method user host localname nil)))))
2362 2414
2363;; This function returns all possible method completions, adding the 2415;; This function returns all possible method completions, adding the
2364;; trailing method delimiter. 2416;; trailing method delimiter.
@@ -2372,7 +2424,8 @@ remote host and localname (filename on remote host)."
2372 (mapcar 'car tramp-methods))) 2424 (mapcar 'car tramp-methods)))
2373 2425
2374;; Compares partial user and host names with possible completions. 2426;; Compares partial user and host names with possible completions.
2375(defun tramp-get-completion-user-host (method partial-user partial-host user host) 2427(defun tramp-get-completion-user-host
2428 (method partial-user partial-host user host)
2376 "Returns the most expanded string for user and host name completion. 2429 "Returns the most expanded string for user and host name completion.
2377PARTIAL-USER must match USER, PARTIAL-HOST must match HOST." 2430PARTIAL-USER must match USER, PARTIAL-HOST must match HOST."
2378 (cond 2431 (cond
@@ -2403,21 +2456,36 @@ PARTIAL-USER must match USER, PARTIAL-HOST must match HOST."
2403 (unless (zerop (+ (length user) (length host))) 2456 (unless (zerop (+ (length user) (length host)))
2404 (tramp-completion-make-tramp-file-name method user host nil))) 2457 (tramp-completion-make-tramp-file-name method user host nil)))
2405 2458
2406;;;###tramp-autoload 2459;; Generic function.
2407(defun tramp-parse-rhosts (filename) 2460(defun tramp-parse-group (regexp match-level skip-regexp)
2461 "Return a (user host) tuple allowed to access.
2462User is always nil."
2463 (let (result)
2464 (when (re-search-forward regexp (point-at-eol) t)
2465 (setq result (list nil (match-string match-level))))
2466 (or
2467 (> (skip-chars-forward skip-regexp) 0)
2468 (forward-line 1))
2469 result))
2470
2471;; Generic function.
2472(defun tramp-parse-file (filename function)
2408 "Return a list of (user host) tuples allowed to access. 2473 "Return a list of (user host) tuples allowed to access.
2409Either user or host may be nil." 2474User is always nil."
2410 ;; On Windows, there are problems in completion when 2475 ;; On Windows, there are problems in completion when
2411 ;; `default-directory' is remote. 2476 ;; `default-directory' is remote.
2412 (let ((default-directory (tramp-compat-temporary-file-directory)) 2477 (let ((default-directory (tramp-compat-temporary-file-directory)))
2413 res)
2414 (when (file-readable-p filename) 2478 (when (file-readable-p filename)
2415 (with-temp-buffer 2479 (with-temp-buffer
2416 (insert-file-contents filename) 2480 (insert-file-contents filename)
2417 (goto-char (point-min)) 2481 (goto-char (point-min))
2418 (while (not (eobp)) 2482 (loop while (not (eobp)) collect (funcall function))))))
2419 (push (tramp-parse-rhosts-group) res)))) 2483
2420 res)) 2484;;;###tramp-autoload
2485(defun tramp-parse-rhosts (filename)
2486 "Return a list of (user host) tuples allowed to access.
2487Either user or host may be nil."
2488 (tramp-parse-file filename 'tramp-parse-rhosts-group))
2421 2489
2422(defun tramp-parse-rhosts-group () 2490(defun tramp-parse-rhosts-group ()
2423 "Return a (user host) tuple allowed to access. 2491 "Return a (user host) tuple allowed to access.
@@ -2427,10 +2495,8 @@ Either user or host may be nil."
2427 (concat 2495 (concat
2428 "^\\(" tramp-host-regexp "\\)" 2496 "^\\(" tramp-host-regexp "\\)"
2429 "\\([ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?"))) 2497 "\\([ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?")))
2430 (narrow-to-region (point) (point-at-eol)) 2498 (when (re-search-forward regexp (point-at-eol) t)
2431 (when (re-search-forward regexp nil t)
2432 (setq result (append (list (match-string 3) (match-string 1))))) 2499 (setq result (append (list (match-string 3) (match-string 1)))))
2433 (widen)
2434 (forward-line 1) 2500 (forward-line 1)
2435 result)) 2501 result))
2436 2502
@@ -2438,124 +2504,63 @@ Either user or host may be nil."
2438(defun tramp-parse-shosts (filename) 2504(defun tramp-parse-shosts (filename)
2439 "Return a list of (user host) tuples allowed to access. 2505 "Return a list of (user host) tuples allowed to access.
2440User is always nil." 2506User is always nil."
2441 ;; On Windows, there are problems in completion when 2507 (tramp-parse-file filename 'tramp-parse-shosts-group))
2442 ;; `default-directory' is remote.
2443 (let ((default-directory (tramp-compat-temporary-file-directory))
2444 res)
2445 (when (file-readable-p filename)
2446 (with-temp-buffer
2447 (insert-file-contents filename)
2448 (goto-char (point-min))
2449 (while (not (eobp))
2450 (push (tramp-parse-shosts-group) res))))
2451 res))
2452 2508
2453(defun tramp-parse-shosts-group () 2509(defun tramp-parse-shosts-group ()
2454 "Return a (user host) tuple allowed to access. 2510 "Return a (user host) tuple allowed to access.
2455User is always nil." 2511User is always nil."
2456 (let ((result) 2512 (tramp-parse-group (concat "^\\(" tramp-host-regexp "\\)") 1 ","))
2457 (regexp (concat "^\\(" tramp-host-regexp "\\)")))
2458 (narrow-to-region (point) (point-at-eol))
2459 (when (re-search-forward regexp nil t)
2460 (setq result (list nil (match-string 1))))
2461 (widen)
2462 (or
2463 (> (skip-chars-forward ",") 0)
2464 (forward-line 1))
2465 result))
2466 2513
2467;;;###tramp-autoload 2514;;;###tramp-autoload
2468(defun tramp-parse-sconfig (filename) 2515(defun tramp-parse-sconfig (filename)
2469 "Return a list of (user host) tuples allowed to access. 2516 "Return a list of (user host) tuples allowed to access.
2470User is always nil." 2517User is always nil."
2471 ;; On Windows, there are problems in completion when 2518 (tramp-parse-file filename 'tramp-parse-sconfig-group))
2472 ;; `default-directory' is remote.
2473 (let ((default-directory (tramp-compat-temporary-file-directory))
2474 res)
2475 (when (file-readable-p filename)
2476 (with-temp-buffer
2477 (insert-file-contents filename)
2478 (goto-char (point-min))
2479 (while (not (eobp))
2480 (push (tramp-parse-sconfig-group) res))))
2481 res))
2482 2519
2483(defun tramp-parse-sconfig-group () 2520(defun tramp-parse-sconfig-group ()
2484 "Return a (user host) tuple allowed to access. 2521 "Return a (user host) tuple allowed to access.
2485User is always nil." 2522User is always nil."
2486 (let ((result) 2523 (tramp-parse-group
2487 (regexp (concat "^[ \t]*Host[ \t]+" "\\(" tramp-host-regexp "\\)"))) 2524 (concat "^[ \t]*Host[ \t]+" "\\(" tramp-host-regexp "\\)") 1 ","))
2488 (narrow-to-region (point) (point-at-eol))
2489 (when (re-search-forward regexp nil t)
2490 (setq result (list nil (match-string 1))))
2491 (widen)
2492 (or
2493 (> (skip-chars-forward ",") 0)
2494 (forward-line 1))
2495 result))
2496 2525
2497;;;###tramp-autoload 2526;; Generic function.
2498(defun tramp-parse-shostkeys (dirname) 2527(defun tramp-parse-shostkeys-sknownhosts (dirname regexp)
2499 "Return a list of (user host) tuples allowed to access. 2528 "Return a list of (user host) tuples allowed to access.
2500User is always nil." 2529User is always nil."
2501 ;; On Windows, there are problems in completion when 2530 ;; On Windows, there are problems in completion when
2502 ;; `default-directory' is remote. 2531 ;; `default-directory' is remote.
2503 (let* ((default-directory (tramp-compat-temporary-file-directory)) 2532 (let* ((default-directory (tramp-compat-temporary-file-directory))
2504 (regexp (concat "^key_[0-9]+_\\(" tramp-host-regexp "\\)\\.pub$")) 2533 (files (and (file-directory-p dirname) (directory-files dirname))))
2505 (files (when (file-directory-p dirname) (directory-files dirname))) 2534 (loop for f in files
2506 result) 2535 when (and (not (string-match "^\\.\\.?$" f)) (string-match regexp f))
2507 (while files 2536 collect (list nil (match-string 1 f)))))
2508 (when (string-match regexp (car files)) 2537
2509 (push (list nil (match-string 1 (car files))) result)) 2538;;;###tramp-autoload
2510 (setq files (cdr files))) 2539(defun tramp-parse-shostkeys (dirname)
2511 result)) 2540 "Return a list of (user host) tuples allowed to access.
2541User is always nil."
2542 (tramp-parse-shostkeys-sknownhosts
2543 dirname (concat "^key_[0-9]+_\\(" tramp-host-regexp "\\)\\.pub$")))
2512 2544
2545;;;###tramp-autoload
2513(defun tramp-parse-sknownhosts (dirname) 2546(defun tramp-parse-sknownhosts (dirname)
2514 "Return a list of (user host) tuples allowed to access. 2547 "Return a list of (user host) tuples allowed to access.
2515User is always nil." 2548User is always nil."
2516 ;; On Windows, there are problems in completion when 2549 (tramp-parse-shostkeys-sknownhosts
2517 ;; `default-directory' is remote. 2550 dirname
2518 (let* ((default-directory (tramp-compat-temporary-file-directory)) 2551 (concat "^\\(" tramp-host-regexp "\\)\\.ssh-\\(dss\\|rsa\\)\\.pub$")))
2519 (regexp (concat "^\\(" tramp-host-regexp
2520 "\\)\\.ssh-\\(dss\\|rsa\\)\\.pub$"))
2521 (files (when (file-directory-p dirname) (directory-files dirname)))
2522 result)
2523 (while files
2524 (when (string-match regexp (car files))
2525 (push (list nil (match-string 1 (car files))) result))
2526 (setq files (cdr files)))
2527 result))
2528 2552
2529;;;###tramp-autoload 2553;;;###tramp-autoload
2530(defun tramp-parse-hosts (filename) 2554(defun tramp-parse-hosts (filename)
2531 "Return a list of (user host) tuples allowed to access. 2555 "Return a list of (user host) tuples allowed to access.
2532User is always nil." 2556User is always nil."
2533 ;; On Windows, there are problems in completion when 2557 (tramp-parse-file filename 'tramp-parse-hosts-group))
2534 ;; `default-directory' is remote.
2535 (let ((default-directory (tramp-compat-temporary-file-directory))
2536 res)
2537 (when (file-readable-p filename)
2538 (with-temp-buffer
2539 (insert-file-contents filename)
2540 (goto-char (point-min))
2541 (while (not (eobp))
2542 (push (tramp-parse-hosts-group) res))))
2543 res))
2544 2558
2545(defun tramp-parse-hosts-group () 2559(defun tramp-parse-hosts-group ()
2546 "Return a (user host) tuple allowed to access. 2560 "Return a (user host) tuple allowed to access.
2547User is always nil." 2561User is always nil."
2548 (let ((result) 2562 (tramp-parse-group
2549 (regexp 2563 (concat "^\\(" tramp-ipv6-regexp "\\|" tramp-host-regexp "\\)") 1 " \t"))
2550 (concat "^\\(" tramp-ipv6-regexp "\\|" tramp-host-regexp "\\)")))
2551 (narrow-to-region (point) (point-at-eol))
2552 (when (re-search-forward regexp nil t)
2553 (setq result (list nil (match-string 1))))
2554 (widen)
2555 (or
2556 (> (skip-chars-forward " \t") 0)
2557 (forward-line 1))
2558 result))
2559 2564
2560;; For su-alike methods it would be desirable to return "root@localhost" 2565;; For su-alike methods it would be desirable to return "root@localhost"
2561;; as default. Unfortunately, we have no information whether any user name 2566;; as default. Unfortunately, we have no information whether any user name
@@ -2565,29 +2570,17 @@ User is always nil."
2565(defun tramp-parse-passwd (filename) 2570(defun tramp-parse-passwd (filename)
2566 "Return a list of (user host) tuples allowed to access. 2571 "Return a list of (user host) tuples allowed to access.
2567Host is always \"localhost\"." 2572Host is always \"localhost\"."
2568 ;; On Windows, there are problems in completion when 2573 (if (zerop (length tramp-current-user))
2569 ;; `default-directory' is remote. 2574 '(("root" nil))
2570 (let ((default-directory (tramp-compat-temporary-file-directory)) 2575 (tramp-parse-file filename 'tramp-parse-passwd-group)))
2571 res)
2572 (if (zerop (length tramp-current-user))
2573 '(("root" nil))
2574 (when (file-readable-p filename)
2575 (with-temp-buffer
2576 (insert-file-contents filename)
2577 (goto-char (point-min))
2578 (while (not (eobp))
2579 (push (tramp-parse-passwd-group) res))))
2580 res)))
2581 2576
2582(defun tramp-parse-passwd-group () 2577(defun tramp-parse-passwd-group ()
2583 "Return a (user host) tuple allowed to access. 2578 "Return a (user host) tuple allowed to access.
2584Host is always \"localhost\"." 2579Host is always \"localhost\"."
2585 (let ((result) 2580 (let ((result)
2586 (regexp (concat "^\\(" tramp-user-regexp "\\):"))) 2581 (regexp (concat "^\\(" tramp-user-regexp "\\):")))
2587 (narrow-to-region (point) (point-at-eol)) 2582 (when (re-search-forward regexp (point-at-eol) t)
2588 (when (re-search-forward regexp nil t)
2589 (setq result (list (match-string 1) "localhost"))) 2583 (setq result (list (match-string 1) "localhost")))
2590 (widen)
2591 (forward-line 1) 2584 (forward-line 1)
2592 result)) 2585 result))
2593 2586
@@ -2595,17 +2588,7 @@ Host is always \"localhost\"."
2595(defun tramp-parse-netrc (filename) 2588(defun tramp-parse-netrc (filename)
2596 "Return a list of (user host) tuples allowed to access. 2589 "Return a list of (user host) tuples allowed to access.
2597User may be nil." 2590User may be nil."
2598 ;; On Windows, there are problems in completion when 2591 (tramp-parse-file filename 'tramp-parse-netrc-group))
2599 ;; `default-directory' is remote.
2600 (let ((default-directory (tramp-compat-temporary-file-directory))
2601 res)
2602 (when (file-readable-p filename)
2603 (with-temp-buffer
2604 (insert-file-contents filename)
2605 (goto-char (point-min))
2606 (while (not (eobp))
2607 (push (tramp-parse-netrc-group) res))))
2608 res))
2609 2592
2610(defun tramp-parse-netrc-group () 2593(defun tramp-parse-netrc-group ()
2611 "Return a (user host) tuple allowed to access. 2594 "Return a (user host) tuple allowed to access.
@@ -2615,37 +2598,33 @@ User may be nil."
2615 (concat 2598 (concat
2616 "^[ \t]*machine[ \t]+" "\\(" tramp-host-regexp "\\)" 2599 "^[ \t]*machine[ \t]+" "\\(" tramp-host-regexp "\\)"
2617 "\\([ \t]+login[ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?"))) 2600 "\\([ \t]+login[ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?")))
2618 (narrow-to-region (point) (point-at-eol)) 2601 (when (re-search-forward regexp (point-at-eol) t)
2619 (when (re-search-forward regexp nil t)
2620 (setq result (list (match-string 3) (match-string 1)))) 2602 (setq result (list (match-string 3) (match-string 1))))
2621 (widen)
2622 (forward-line 1) 2603 (forward-line 1)
2623 result)) 2604 result))
2624 2605
2625;;;###tramp-autoload 2606;;;###tramp-autoload
2626(defun tramp-parse-putty (registry) 2607(defun tramp-parse-putty (registry-or-dirname)
2627 "Return a list of (user host) tuples allowed to access. 2608 "Return a list of (user host) tuples allowed to access.
2628User is always nil." 2609User is always nil."
2629 ;; On Windows, there are problems in completion when 2610 (if (memq system-type '(windows-nt))
2630 ;; `default-directory' is remote. 2611 (with-temp-buffer
2631 (let ((default-directory (tramp-compat-temporary-file-directory)) 2612 (when (zerop (tramp-compat-call-process
2632 res) 2613 "reg" nil t nil "query" registry-or-dirname))
2633 (with-temp-buffer 2614 (goto-char (point-min))
2634 (when (zerop (tramp-compat-call-process "reg" nil t nil "query" registry)) 2615 (loop while (not (eobp)) collect
2635 (goto-char (point-min)) 2616 (tramp-parse-putty-group registry-or-dirname))))
2636 (while (not (eobp)) 2617 ;; UNIX case.
2637 (push (tramp-parse-putty-group registry) res)))) 2618 (tramp-parse-shostkeys-sknownhosts
2638 res)) 2619 registry-or-dirname (concat "^\\(" tramp-host-regexp "\\)$"))))
2639 2620
2640(defun tramp-parse-putty-group (registry) 2621(defun tramp-parse-putty-group (registry)
2641 "Return a (user host) tuple allowed to access. 2622 "Return a (user host) tuple allowed to access.
2642User is always nil." 2623User is always nil."
2643 (let ((result) 2624 (let ((result)
2644 (regexp (concat (regexp-quote registry) "\\\\\\(.+\\)"))) 2625 (regexp (concat (regexp-quote registry) "\\\\\\(.+\\)")))
2645 (narrow-to-region (point) (point-at-eol)) 2626 (when (re-search-forward regexp (point-at-eol) t)
2646 (when (re-search-forward regexp nil t)
2647 (setq result (list nil (match-string 1)))) 2627 (setq result (list nil (match-string 1))))
2648 (widen)
2649 (forward-line 1) 2628 (forward-line 1)
2650 result)) 2629 result))
2651 2630
@@ -2855,78 +2834,80 @@ User is always nil."
2855 (setq filename (expand-file-name filename)) 2834 (setq filename (expand-file-name filename))
2856 (let (result local-copy remote-copy) 2835 (let (result local-copy remote-copy)
2857 (with-parsed-tramp-file-name filename nil 2836 (with-parsed-tramp-file-name filename nil
2858 (unwind-protect 2837 (tramp-with-progress-reporter
2859 (if (not (file-exists-p filename)) 2838 v 3 (format "Inserting `%s'" filename)
2860 ;; We don't raise a Tramp error, because it might be 2839 (unwind-protect
2861 ;; suppressed, like in `find-file-noselect-1'. 2840 (if (not (file-exists-p filename))
2862 (signal 'file-error 2841 ;; We don't raise a Tramp error, because it might be
2863 (list "File not found on remote host" filename)) 2842 ;; suppressed, like in `find-file-noselect-1'.
2864 2843 (signal 'file-error
2865 (if (and (tramp-local-host-p v) 2844 (list "File not found on remote host" filename))
2866 (let (file-name-handler-alist) 2845
2867 (file-readable-p localname))) 2846 (if (and (tramp-local-host-p v)
2868 ;; Short track: if we are on the local host, we can 2847 (let (file-name-handler-alist)
2869 ;; run directly. 2848 (file-readable-p localname)))
2870 (setq result 2849 ;; Short track: if we are on the local host, we can
2871 (tramp-run-real-handler 2850 ;; run directly.
2872 'insert-file-contents 2851 (setq result
2873 (list localname visit beg end replace))) 2852 (tramp-run-real-handler
2874 2853 'insert-file-contents
2875 ;; When we shall insert only a part of the file, we copy 2854 (list localname visit beg end replace)))
2876 ;; this part. 2855
2877 (when (or beg end) 2856 ;; When we shall insert only a part of the file, we
2878 (setq remote-copy (tramp-make-tramp-temp-file v)) 2857 ;; copy this part.
2879 ;; This is defined in tramp-sh.el. Let's assume this 2858 (when (or beg end)
2880 ;; is loaded already. 2859 (setq remote-copy (tramp-make-tramp-temp-file v))
2881 (tramp-compat-funcall 'tramp-send-command 2860 ;; This is defined in tramp-sh.el. Let's assume
2882 v 2861 ;; this is loaded already.
2883 (cond 2862 (tramp-compat-funcall
2884 ((and beg end) 2863 'tramp-send-command
2885 (format "dd bs=1 skip=%d if=%s count=%d of=%s" 2864 v
2886 beg (tramp-shell-quote-argument localname) 2865 (cond
2887 (- end beg) remote-copy)) 2866 ((and beg end)
2888 (beg 2867 (format "dd bs=1 skip=%d if=%s count=%d of=%s"
2889 (format "dd bs=1 skip=%d if=%s of=%s" 2868 beg (tramp-shell-quote-argument localname)
2890 beg (tramp-shell-quote-argument localname) 2869 (- end beg) remote-copy))
2891 remote-copy)) 2870 (beg
2892 (end 2871 (format "dd bs=1 skip=%d if=%s of=%s"
2893 (format "dd bs=1 count=%d if=%s of=%s" 2872 beg (tramp-shell-quote-argument localname)
2894 end (tramp-shell-quote-argument localname) 2873 remote-copy))
2895 remote-copy))))) 2874 (end
2896 2875 (format "dd bs=1 count=%d if=%s of=%s"
2897 ;; `insert-file-contents-literally' takes care to avoid 2876 end (tramp-shell-quote-argument localname)
2898 ;; calling jka-compr. By let-binding 2877 remote-copy)))))
2899 ;; `inhibit-file-name-operation', we propagate that care 2878
2900 ;; to the `file-local-copy' operation. 2879 ;; `insert-file-contents-literally' takes care to
2901 (setq local-copy 2880 ;; avoid calling jka-compr. By let-binding
2902 (let ((inhibit-file-name-operation 2881 ;; `inhibit-file-name-operation', we propagate that
2903 (when (eq inhibit-file-name-operation 2882 ;; care to the `file-local-copy' operation.
2904 'insert-file-contents) 2883 (setq local-copy
2905 'file-local-copy))) 2884 (let ((inhibit-file-name-operation
2906 (cond 2885 (when (eq inhibit-file-name-operation
2907 ((stringp remote-copy) 2886 'insert-file-contents)
2908 (file-local-copy 2887 'file-local-copy)))
2909 (tramp-make-tramp-file-name 2888 (cond
2910 method user host remote-copy))) 2889 ((stringp remote-copy)
2911 ((stringp tramp-temp-buffer-file-name) 2890 (file-local-copy
2912 (copy-file filename tramp-temp-buffer-file-name 'ok) 2891 (tramp-make-tramp-file-name
2913 tramp-temp-buffer-file-name) 2892 method user host remote-copy)))
2914 (t (file-local-copy filename))))) 2893 ((stringp tramp-temp-buffer-file-name)
2915 2894 (copy-file filename tramp-temp-buffer-file-name 'ok)
2916 ;; When the file is not readable for the owner, it 2895 tramp-temp-buffer-file-name)
2917 ;; cannot be inserted, even if it is readable for the 2896 (t (file-local-copy filename)))))
2918 ;; group or for everybody. 2897
2919 (set-file-modes local-copy (tramp-compat-octal-to-decimal "0600")) 2898 ;; When the file is not readable for the owner, it
2920 2899 ;; cannot be inserted, even if it is readable for the
2921 (when (and (null remote-copy) 2900 ;; group or for everybody.
2922 (tramp-get-method-parameter 2901 (set-file-modes
2923 method 'tramp-copy-keep-tmpfile)) 2902 local-copy (tramp-compat-octal-to-decimal "0600"))
2924 ;; We keep the local file for performance reasons, 2903
2925 ;; useful for "rsync". 2904 (when (and (null remote-copy)
2926 (setq tramp-temp-buffer-file-name local-copy)) 2905 (tramp-get-method-parameter
2927 2906 method 'tramp-copy-keep-tmpfile))
2928 (tramp-with-progress-reporter 2907 ;; We keep the local file for performance reasons,
2929 v 3 (format "Inserting local temp file `%s'" local-copy) 2908 ;; useful for "rsync".
2909 (setq tramp-temp-buffer-file-name local-copy))
2910
2930 ;; We must ensure that `file-coding-system-alist' 2911 ;; We must ensure that `file-coding-system-alist'
2931 ;; matches `local-copy'. 2912 ;; matches `local-copy'.
2932 (let ((file-coding-system-alist 2913 (let ((file-coding-system-alist
@@ -2934,21 +2915,21 @@ User is always nil."
2934 filename local-copy))) 2915 filename local-copy)))
2935 (setq result 2916 (setq result
2936 (insert-file-contents 2917 (insert-file-contents
2937 local-copy nil nil nil replace)))))) 2918 local-copy nil nil nil replace)))))
2938 2919
2939 ;; Save exit. 2920 ;; Save exit.
2940 (progn 2921 (progn
2941 (when visit 2922 (when visit
2942 (setq buffer-file-name filename) 2923 (setq buffer-file-name filename)
2943 (setq buffer-read-only (not (file-writable-p filename))) 2924 (setq buffer-read-only (not (file-writable-p filename)))
2944 (set-visited-file-modtime) 2925 (set-visited-file-modtime)
2945 (set-buffer-modified-p nil)) 2926 (set-buffer-modified-p nil))
2946 (when (and (stringp local-copy) 2927 (when (and (stringp local-copy)
2947 (or remote-copy (null tramp-temp-buffer-file-name))) 2928 (or remote-copy (null tramp-temp-buffer-file-name)))
2948 (delete-file local-copy)) 2929 (delete-file local-copy))
2949 (when (stringp remote-copy) 2930 (when (stringp remote-copy)
2950 (delete-file 2931 (delete-file
2951 (tramp-make-tramp-file-name method user host remote-copy)))))) 2932 (tramp-make-tramp-file-name method user host remote-copy)))))))
2952 2933
2953 ;; Result. 2934 ;; Result.
2954 (list (expand-file-name filename) 2935 (list (expand-file-name filename)
@@ -3136,7 +3117,10 @@ beginning of local filename are not substituted."
3136 (let ((enable-recursive-minibuffers t)) 3117 (let ((enable-recursive-minibuffers t))
3137 (tramp-check-for-regexp proc tramp-password-prompt-regexp) 3118 (tramp-check-for-regexp proc tramp-password-prompt-regexp)
3138 (tramp-message vec 3 "Sending %s" (match-string 1)) 3119 (tramp-message vec 3 "Sending %s" (match-string 1))
3139 (tramp-enter-password proc) 3120 ;; We don't call `tramp-send-string' in order to hide the
3121 ;; password from the debug buffer.
3122 (process-send-string
3123 proc (concat (tramp-read-passwd proc) tramp-local-end-of-line))
3140 ;; Hide password prompt. 3124 ;; Hide password prompt.
3141 (narrow-to-region (point-max) (point-max))))) 3125 (narrow-to-region (point-max) (point-max)))))
3142 3126
@@ -3240,7 +3224,7 @@ set, is the starting point of the region to be deleted in the
3240connection buffer." 3224connection buffer."
3241 ;; Preserve message for `progress-reporter'. 3225 ;; Preserve message for `progress-reporter'.
3242 (tramp-compat-with-temp-message "" 3226 (tramp-compat-with-temp-message ""
3243 ;; Enable auth-source and password-cache. We must use 3227 ;; Enable `auth-source' and `password-cache'. We must use
3244 ;; tramp-current-* variables in case we have several hops. 3228 ;; tramp-current-* variables in case we have several hops.
3245 (tramp-set-connection-property 3229 (tramp-set-connection-property
3246 (tramp-dissect-file-name 3230 (tramp-dissect-file-name
@@ -3315,14 +3299,12 @@ Erase echoed commands if exists."
3315 'buffer-substring-no-properties 3299 'buffer-substring-no-properties
3316 1 (min (1+ tramp-echo-mark-marker-length) (point-max)))))) 3300 1 (min (1+ tramp-echo-mark-marker-length) (point-max))))))
3317 ;; No echo to be handled, now we can look for the regexp. 3301 ;; No echo to be handled, now we can look for the regexp.
3318 ;; Sometimes, the buffer is much to huge, and we run into a 3302 ;; Sometimes, lines are much to long, and we run into a "Stack
3319 ;; "Stack overflow in regexp matcher". For example, directory 3303 ;; overflow in regexp matcher". For example, //DIRED// lines of
3320 ;; listings with some thousand files. Therefore, we look from 3304 ;; directory listings with some thousand files. Therefore, we
3321 ;; the end for the last line. We ignore also superlong lines, 3305 ;; look from the end.
3322 ;; like created with "//DIRED//".
3323 (goto-char (point-max)) 3306 (goto-char (point-max))
3324 (unless (> (- (point) (point-at-bol)) 128) 3307 (ignore-errors (re-search-backward regexp nil t)))))
3325 (re-search-backward regexp (point-at-bol) t)))))
3326 3308
3327(defun tramp-wait-for-regexp (proc timeout regexp) 3309(defun tramp-wait-for-regexp (proc timeout regexp)
3328 "Wait for a REGEXP to appear from process PROC within TIMEOUT seconds. 3310 "Wait for a REGEXP to appear from process PROC within TIMEOUT seconds.
@@ -3362,18 +3344,6 @@ nil."
3362 (tramp-error proc 'file-error "[[Regexp `%s' not found]]" regexp))) 3344 (tramp-error proc 'file-error "[[Regexp `%s' not found]]" regexp)))
3363 found))) 3345 found)))
3364 3346
3365;; We don't call `tramp-send-string' in order to hide the password
3366;; from the debug buffer, and because end-of-line handling of the
3367;; string.
3368(defun tramp-enter-password (proc)
3369 "Prompt for a password and send it to the remote end."
3370 (process-send-string
3371 proc (concat (tramp-read-passwd proc)
3372 (or (tramp-get-method-parameter
3373 tramp-current-method
3374 'tramp-password-end-of-line)
3375 tramp-default-password-end-of-line))))
3376
3377;; It seems that Tru64 Unix does not like it if long strings are sent 3347;; It seems that Tru64 Unix does not like it if long strings are sent
3378;; to it in one go. (This happens when sending the Perl 3348;; to it in one go. (This happens when sending the Perl
3379;; `file-attributes' implementation, for instance.) Therefore, we 3349;; `file-attributes' implementation, for instance.) Therefore, we
@@ -3446,12 +3416,7 @@ would yield `t'. On the other hand, the following check results in nil:
3446 (stringp (file-remote-p file2)) 3416 (stringp (file-remote-p file2))
3447 (string-equal (file-remote-p file1) (file-remote-p file2)))) 3417 (string-equal (file-remote-p file1) (file-remote-p file2))))
3448 3418
3449(defun tramp-get-method-parameter (method param) 3419;;;###tramp-autoload
3450 "Return the method parameter PARAM.
3451If the `tramp-methods' entry does not exist, return nil."
3452 (let ((entry (assoc param (assoc method tramp-methods))))
3453 (when entry (cadr entry))))
3454
3455(defun tramp-mode-string-to-int (mode-string) 3420(defun tramp-mode-string-to-int (mode-string)
3456 "Converts a ten-letter `drwxrwxrwx'-style mode string into mode bits." 3421 "Converts a ten-letter `drwxrwxrwx'-style mode string into mode bits."
3457 (let* (case-fold-search 3422 (let* (case-fold-search
@@ -3523,6 +3488,7 @@ If the `tramp-methods' entry does not exist, return nil."
3523 (t (error "Tenth char `%c' must be one of `xtT-'" 3488 (t (error "Tenth char `%c' must be one of `xtT-'"
3524 other-execute-or-sticky))))))) 3489 other-execute-or-sticky)))))))
3525 3490
3491;;;###tramp-autoload
3526(defun tramp-local-host-p (vec) 3492(defun tramp-local-host-p (vec)
3527 "Return t if this points to the local host, nil otherwise." 3493 "Return t if this points to the local host, nil otherwise."
3528 ;; We cannot use `tramp-file-name-real-host'. A port is an 3494 ;; We cannot use `tramp-file-name-real-host'. A port is an
@@ -3564,6 +3530,7 @@ If the `tramp-methods' entry does not exist, return nil."
3564 dir 3530 dir
3565 (tramp-error vec 'file-error "Directory %s not accessible" dir))))) 3531 (tramp-error vec 'file-error "Directory %s not accessible" dir)))))
3566 3532
3533;;;###tramp-autoload
3567(defun tramp-make-tramp-temp-file (vec) 3534(defun tramp-make-tramp-temp-file (vec)
3568 "Create a temporary file on the remote host identified by VEC. 3535 "Create a temporary file on the remote host identified by VEC.
3569Return the local name of the temporary file." 3536Return the local name of the temporary file."
@@ -3658,6 +3625,7 @@ ALIST is of the form ((FROM . TO) ...)."
3658 3625
3659;;; Compatibility functions section: 3626;;; Compatibility functions section:
3660 3627
3628;;;###tramp-autoload
3661(defun tramp-read-passwd (proc &optional prompt) 3629(defun tramp-read-passwd (proc &optional prompt)
3662 "Read a password from user (compat function). 3630 "Read a password from user (compat function).
3663Consults the auth-source package. 3631Consults the auth-source package.
@@ -3708,6 +3676,7 @@ Invokes `password-read' if available, `read-passwd' else."
3708 (read-passwd pw-prompt)) 3676 (read-passwd pw-prompt))
3709 (tramp-set-connection-property v "first-password-request" nil))))) 3677 (tramp-set-connection-property v "first-password-request" nil)))))
3710 3678
3679;;;###tramp-autoload
3711(defun tramp-clear-passwd (vec) 3680(defun tramp-clear-passwd (vec)
3712 "Clear password cache for connection related to VEC." 3681 "Clear password cache for connection related to VEC."
3713 (tramp-compat-funcall 3682 (tramp-compat-funcall
@@ -3730,6 +3699,7 @@ Invokes `password-read' if available, `read-passwd' else."
3730 ("oct" . 10) ("nov" . 11) ("dec" . 12)) 3699 ("oct" . 10) ("nov" . 11) ("dec" . 12))
3731 "Alist mapping month names to integers.") 3700 "Alist mapping month names to integers.")
3732 3701
3702;;;###tramp-autoload
3733(defun tramp-time-less-p (t1 t2) 3703(defun tramp-time-less-p (t1 t2)
3734 "Say whether time value T1 is less than time value T2." 3704 "Say whether time value T1 is less than time value T2."
3735 (unless t1 (setq t1 '(0 0))) 3705 (unless t1 (setq t1 '(0 0)))
@@ -3747,6 +3717,7 @@ Return the difference in the format of a time value."
3747 (list (- (car t1) (car t2) (if borrow 1 0)) 3717 (list (- (car t1) (car t2) (if borrow 1 0))
3748 (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2))))) 3718 (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
3749 3719
3720;;;###tramp-autoload
3750(defun tramp-time-diff (t1 t2) 3721(defun tramp-time-diff (t1 t2)
3751 "Return the difference between the two times, in seconds. 3722 "Return the difference between the two times, in seconds.
3752T1 and T2 are time values (as returned by `current-time' for example)." 3723T1 and T2 are time values (as returned by `current-time' for example)."
@@ -3841,8 +3812,6 @@ Only works for Bourne-like shells."
3841;; again. (Greg Stark) 3812;; again. (Greg Stark)
3842;; * Username and hostname completion. 3813;; * Username and hostname completion.
3843;; ** Try to avoid usage of `last-input-event' in `tramp-completion-mode-p'. 3814;; ** Try to avoid usage of `last-input-event' in `tramp-completion-mode-p'.
3844;; ** Unify `tramp-parse-{rhosts,shosts,sconfig,hosts,passwd,netrc}'.
3845;; Code is nearly identical.
3846;; * Make `tramp-default-user' obsolete. 3815;; * Make `tramp-default-user' obsolete.
3847;; * Implement a general server-local-variable mechanism, as there are 3816;; * Implement a general server-local-variable mechanism, as there are
3848;; probably other variables that need different values for different 3817;; probably other variables that need different values for different
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index f028c6e943f..499af730788 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -31,7 +31,7 @@
31;; should be changed only there. 31;; should be changed only there.
32 32
33;;;###tramp-autoload 33;;;###tramp-autoload
34(defconst tramp-version "2.2.3-24.1" 34(defconst tramp-version "2.2.6-pre"
35 "This version of Tramp.") 35 "This version of Tramp.")
36 36
37;;;###tramp-autoload 37;;;###tramp-autoload
@@ -44,7 +44,7 @@
44 (= emacs-major-version 21) 44 (= emacs-major-version 21)
45 (>= emacs-minor-version 4))) 45 (>= emacs-minor-version 4)))
46 "ok" 46 "ok"
47 (format "Tramp 2.2.3-24.1 is not fit for %s" 47 (format "Tramp 2.2.6-pre is not fit for %s"
48 (when (string-match "^.*$" (emacs-version)) 48 (when (string-match "^.*$" (emacs-version))
49 (match-string 0 (emacs-version))))))) 49 (match-string 0 (emacs-version)))))))
50 (unless (string-match "\\`ok\\'" x) (error "%s" x))) 50 (unless (string-match "\\`ok\\'" x) (error "%s" x)))