diff options
| author | Michael Albinus | 2012-06-11 12:30:07 +0200 |
|---|---|---|
| committer | Michael Albinus | 2012-06-11 12:30:07 +0200 |
| commit | 2fe4b1254dc0673e161e7aee6ef6f983af86289b (patch) | |
| tree | 5e93be19d0d9be8fa085d528c03f9b780ce35f34 | |
| parent | 72834e10a691114e39a9ad3d3abe93ae9ae83d11 (diff) | |
| download | emacs-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/ChangeLog | 145 | ||||
| -rw-r--r-- | lisp/net/tramp-cache.el | 3 | ||||
| -rw-r--r-- | lisp/net/tramp-cmds.el | 4 | ||||
| -rw-r--r-- | lisp/net/tramp-compat.el | 94 | ||||
| -rw-r--r-- | lisp/net/tramp-ftp.el | 9 | ||||
| -rw-r--r-- | lisp/net/tramp-gvfs.el | 2 | ||||
| -rw-r--r-- | lisp/net/tramp-gw.el | 2 | ||||
| -rw-r--r-- | lisp/net/tramp-sh.el | 264 | ||||
| -rw-r--r-- | lisp/net/tramp-smb.el | 689 | ||||
| -rw-r--r-- | lisp/net/tramp.el | 681 | ||||
| -rw-r--r-- | lisp/net/trampver.el | 4 |
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 @@ | |||
| 1 | 2012-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 | |||
| 123 | 2012-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 | |||
| 1 | 2012-06-11 Chong Yidong <cyd@gnu.org> | 140 | 2012-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 | ||
| 6212 | 2011-11-16 Michael Albinus <michael.albinus@gmx.de> | 6348 | 2011-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. |
| 51 | This is useful for unified remoting. See | 51 | This 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 | 53 | Ange-FTP will be forwarded to Ange-FTP. Also see the variables |
| 54 | for 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 \ |
| 55 | If it is nil, inline out-of-the-band copy will be used without a check." | 55 | out-of-the-band copy. |
| 56 | If 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. |
| 520 | For every remote host, this variable will be set buffer local, | 520 | For every remote host, this variable will be set buffer local, |
| 521 | keeping the list of existing directories on that host. | 521 | keeping 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 | ||
| 551 | Each element should be a string of the form ENVVARNAME=VALUE. An | 550 | Each 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. |
| 2458 | This is like `dired-recursive-delete-directory' for Tramp files." | 2454 | This 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. |
| 3913 | Each item is a list that looks like this: | 3901 | Each item is a list that looks like this: |
| 3914 | 3902 | ||
| 3915 | \(FORMAT ENCODING DECODING\) | 3903 | \(FORMAT ENCODING DECODING [TEST]\) |
| 3916 | 3904 | ||
| 3917 | FORMAT is symbol describing the encoding/decoding format. It can be | 3905 | FORMAT 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 | ||
| 3927 | If they are variables, this variable is a string containing a Perl | 3915 | If they are variables, this variable is a string containing a Perl |
| 3928 | implementation for this functionality. This Perl program will be transferred | 3916 | implementation for this functionality. This Perl program will be transferred |
| 3929 | to the remote host, and it is available as shell function with the same name.") | 3917 | to the remote host, and it is available as shell function with the same name. |
| 3918 | |||
| 3919 | The optional TEST command can be used for further tests, whether | ||
| 3920 | ENCODING 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'. |
| 4118 | Gateway hops are already opened." | 4120 | Gateway 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. |
| 4217 | Does not do anything if a connection is already open, but re-opens the | 4247 | Does 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. | |||
| 4942 | If no corresponding command is found, nil is returned." | 4978 | If 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 | ||
| 156 | See `tramp-actions-before-shell' for more info.") | 166 | See `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. | ||
| 174 | This list is used for tar-like copy of directories. | ||
| 175 | |||
| 176 | See `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. |
| 221 | Operations not mentioned here will be handled by the default Emacs primitives.") | 243 | Operations 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. | ||
| 248 | If it isn't found in the local $PATH, the absolute path of winexe | ||
| 249 | shall 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. | ||
| 256 | This 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'. | ||
| 263 | This 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. |
| 353 | KEEP-DATE is not handled in case NEWNAME resides on an SMB server. | 490 | KEEP-DATE has no effect in case NEWNAME resides on an SMB server. |
| 354 | PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored." | 491 | PRESERVE-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'. |
| 1221 | Does not do anything if a connection is already open, but re-opens the | 1535 | Does not do anything if a connection is already open, but re-opens the |
| 1222 | connection if a previous connection has died for some reason." | 1536 | connection if a previous connection has died for some reason. |
| 1537 | If 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. |
| 1360 | Returns nil if an error message has appeared." | 1704 | Returns 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 ...)) |
| 120 | It has the same meaning like `bkup-backup-directory-info' from package | 121 | It 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 |
| 122 | file name, the backup directory is prepended with Tramp file name prefix | 123 | file 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 | ||
| 437 | FUNCTION can also be a customer defined function. For more details see | 434 | FUNCTION can also be a customer defined function. For more details see |
| 438 | the info pages.") | 435 | the 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. |
| 473 | I don't think this ever needs to be changed, so please tell me about it | 470 | I don't think this ever needs to be changed, so please tell me about it |
| 474 | if you need to change this. | 471 | if you need to change this." |
| 475 | Also see the method parameter `tramp-password-end-of-line' and the normal | ||
| 476 | variable `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. | ||
| 483 | This variable provides the default value for the method parameter | ||
| 484 | `tramp-password-end-of-line', see `tramp-methods' for more details. | ||
| 485 | |||
| 486 | It 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 | ||
| 489 | password, see `tramp-rsh-end-of-line' for the other cases. | ||
| 490 | |||
| 491 | The 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. |
| 511 | Normally, Tramp expects you to configure `shell-prompt-pattern' | 493 | Normally, Tramp expects you to configure `shell-prompt-pattern' |
| 512 | correctly, but sometimes it happens that you are connecting to a | 494 | correctly, 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. |
| 696 | Derived from `tramp-postfix-method-format'.") | 678 | Derived 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. | ||
| 774 | Derived 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 \ | ||
| 820 | the Tramp file name structure. | 814 | the Tramp file name structure. |
| 821 | 815 | ||
| 822 | The first element REGEXP is a regular expression matching a Tramp file | 816 | The 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 | |||
| 827 | parentheses matches the method name. The third element USER is | 821 | parentheses matches the method name. The third element USER is |
| 828 | similar, but for the user name. The fourth element HOST is similar, | 822 | similar, but for the user name. The fourth element HOST is similar, |
| 829 | but for the host name. The fifth element FILE is for the file name. | 823 | but for the host name. The fifth element FILE is for the file name. |
| 824 | The last element HOP is the ad-hoc hop definition, which could be a | ||
| 825 | cascade of several hops. | ||
| 826 | |||
| 830 | These numbers are passed directly to `match-string', which see. That | 827 | These numbers are passed directly to `match-string', which see. That |
| 831 | means the opening parentheses are counted to identify the pair. | 828 | means 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. |
| 841 | Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and | 838 | Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and |
| 842 | Tramp. See `tramp-file-name-structure' for more explanations. | 839 | Tramp. See `tramp-file-name-structure' for more explanations. |
| @@ -850,7 +847,7 @@ XEmacs uses a separate filename syntax for Tramp and EFS. | |||
| 850 | See `tramp-file-name-structure' for more explanations.") | 847 | See `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. |
| 855 | See `tramp-file-name-structure' for more explanations.") | 852 | See `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. | ||
| 1043 | If 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 | 1196 | When 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)." | |||
| 1357 | This variable is used to disable messages from `tramp-error'. | 1366 | This variable is used to disable messages from `tramp-error'. |
| 1358 | The messages are visible anyway, because an error is raised.") | 1367 | The 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. | ||
| 1371 | This 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. |
| 1362 | VEC-OR-PROC identifies the Tramp buffer to use. It can be either a | 1375 | VEC-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 | |||
| 1439 | the filename structure. It is also used as a prefix for the variables | 1453 | the filename structure. It is also used as a prefix for the variables |
| 1440 | holding the components. For example, if VAR is the symbol `foo', then | 1454 | holding 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 |
| 1442 | the method component, and so on for `foo-user', `foo-host', `foo-localname'. | 1456 | the method component, and so on for `foo-user', `foo-host', `foo-localname', |
| 1457 | `foo-hop'. | ||
| 1443 | 1458 | ||
| 1444 | Remaining args are Lisp expressions to be evaluated (inside an implicit | 1459 | Remaining args are Lisp expressions to be evaluated (inside an implicit |
| 1445 | `progn'). | 1460 | `progn'). |
| 1446 | 1461 | ||
| 1447 | If VAR is nil, then we bind `v' to the structure and `method', `user', | 1462 | If 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." | |||
| 1522 | FUNCTION-LIST is a list of entries of the form (FUNCTION FILE). | 1552 | FUNCTION-LIST is a list of entries of the form (FUNCTION FILE). |
| 1523 | The FUNCTION is intended to parse FILE according its syntax. | 1553 | The FUNCTION is intended to parse FILE according its syntax. |
| 1524 | It might be a predefined FUNCTION, or a user defined FUNCTION. | 1554 | It might be a predefined FUNCTION, or a user defined FUNCTION. |
| 1525 | Predefined FUNCTIONs are `tramp-parse-rhosts', `tramp-parse-shosts', | 1555 | For the list of predefined FUNCTIONs see `tramp-completion-function-alist'. |
| 1526 | `tramp-parse-sconfig', `tramp-parse-hosts', `tramp-parse-passwd', | ||
| 1527 | and `tramp-parse-netrc'. | ||
| 1528 | 1556 | ||
| 1529 | Example: | 1557 | Example: |
| 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. |
| 2377 | PARTIAL-USER must match USER, PARTIAL-HOST must match HOST." | 2430 | PARTIAL-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. | ||
| 2462 | User 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. |
| 2409 | Either user or host may be nil." | 2474 | User 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. | ||
| 2487 | Either 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. |
| 2440 | User is always nil." | 2506 | User 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. |
| 2455 | User is always nil." | 2511 | User 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. |
| 2470 | User is always nil." | 2517 | User 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. |
| 2485 | User is always nil." | 2522 | User 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. |
| 2500 | User is always nil." | 2529 | User 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. |
| 2541 | User 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. |
| 2515 | User is always nil." | 2548 | User 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. |
| 2532 | User is always nil." | 2556 | User 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. |
| 2547 | User is always nil." | 2561 | User 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. |
| 2567 | Host is always \"localhost\"." | 2572 | Host 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. |
| 2584 | Host is always \"localhost\"." | 2579 | Host 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. |
| 2597 | User may be nil." | 2590 | User 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. |
| 2628 | User is always nil." | 2609 | User 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. |
| 2642 | User is always nil." | 2623 | User 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 | |||
| 3240 | connection buffer." | 3224 | connection 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. | ||
| 3451 | If 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. |
| 3569 | Return the local name of the temporary file." | 3536 | Return 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). |
| 3663 | Consults the auth-source package. | 3631 | Consults 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. |
| 3752 | T1 and T2 are time values (as returned by `current-time' for example)." | 3723 | T1 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))) |