[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r108555: Sync with Tramp 2.2.6-pre.
|
From: |
Michael Albinus |
|
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r108555: Sync with Tramp 2.2.6-pre. |
|
Date: |
Mon, 11 Jun 2012 12:30:07 +0200 |
|
User-agent: |
Bazaar (2.5.0) |
------------------------------------------------------------
revno: 108555
committer: Michael Albinus <address@hidden>
branch nick: trunk
timestamp: Mon 2012-06-11 12:30:07 +0200
message:
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
<address@hidden>.
* 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 <address@hidden>.
(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.
modified:
lisp/ChangeLog
lisp/net/tramp-cache.el
lisp/net/tramp-cmds.el
lisp/net/tramp-compat.el
lisp/net/tramp-ftp.el
lisp/net/tramp-gvfs.el
lisp/net/tramp-gw.el
lisp/net/tramp-sh.el
lisp/net/tramp-smb.el
lisp/net/tramp.el
lisp/net/trampver.el
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2012-06-11 10:16:47 +0000
+++ b/lisp/ChangeLog 2012-06-11 10:30:07 +0000
@@ -1,3 +1,142 @@
+2012-06-11 Michael Albinus <address@hidden>
+
+ 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
+ <address@hidden>.
+
+ * 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 <address@hidden>.
+ (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.
+
+2012-06-11 Thierry Volpiatto <address@hidden>
+ Michael Albinus <address@hidden>
+
+ * 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.
+
2012-06-11 Chong Yidong <address@hidden>
* image.el (imagemagick-register-types): Put the ImageMagick entry
@@ -4884,9 +5023,6 @@
* net/tramp.el (tramp-action-login): Set connection property "login-as".
- * net/tramp-cache.el (tramp-dump-connection-properties): Do not dump
- properties, when "login-as" is set.
-
* net/tramp-sh.el (tramp-methods): Add user spec to "pscp" and "psftp".
(tramp-default-user-alist): Don't add "pscp".
(tramp-do-copy-or-rename-file-out-of-band): Use connection
@@ -6211,9 +6347,6 @@
2011-11-16 Michael Albinus <address@hidden>
- * net/tramp-cache.el (tramp-flush-file-property): Flush also
- properties of linked files. (Bug#9879)
-
* net/tramp-sh.el (tramp-sh-handle-file-truename): Cache only the
local file name.
=== modified file 'lisp/net/tramp-cache.el'
--- a/lisp/net/tramp-cache.el 2012-01-22 12:55:36 +0000
+++ b/lisp/net/tramp-cache.el 2012-06-11 10:30:07 +0000
@@ -328,7 +328,8 @@
(not (zerop (hash-table-count tramp-cache-data)))
tramp-cache-data-changed
(stringp tramp-persistency-file-name))
- (let ((cache (copy-hash-table tramp-cache-data)))
+ (let ((cache (copy-hash-table tramp-cache-data))
+ print-length print-level)
;; Remove temporary data. If there is the key "login-as", we
;; don't save either, because all other properties might
;; depend on the login name, and we want to give the
=== modified file 'lisp/net/tramp-cmds.el'
--- a/lisp/net/tramp-cmds.el 2012-01-19 07:21:25 +0000
+++ b/lisp/net/tramp-cmds.el 2012-06-11 10:30:07 +0000
@@ -89,7 +89,9 @@
(tramp-flush-directory-property vec "")
;; Flush connection cache.
- (tramp-flush-connection-property (tramp-get-connection-process vec))
+ (when (processp (tramp-get-connection-process vec))
+ (delete-process (tramp-get-connection-process vec))
+ (tramp-flush-connection-property (tramp-get-connection-process vec)))
(tramp-flush-connection-property vec)
;; Remove buffers.
=== modified file 'lisp/net/tramp-compat.el'
--- a/lisp/net/tramp-compat.el 2012-06-08 13:27:06 +0000
+++ b/lisp/net/tramp-compat.el 2012-06-11 10:30:07 +0000
@@ -194,6 +194,22 @@
"Display MESSAGE temporarily if non-nil while BODY is evaluated."
`(progn ,@body)))
+;; `condition-case-unless-debug' is introduced with Emacs 24.
+(if (fboundp 'condition-case-unless-debug)
+ (defalias 'tramp-compat-condition-case-unless-debug
+ 'condition-case-unless-debug)
+ (defmacro tramp-compat-condition-case-unless-debug
+ (var bodyform &rest handlers)
+ "Like `condition-case' except that it does not catch anything when
debugging."
+ (declare (debug condition-case) (indent 2))
+ (let ((bodysym (make-symbol "body")))
+ `(let ((,bodysym (lambda () ,bodyform)))
+ (if debug-on-error
+ (funcall ,bodysym)
+ (condition-case ,var
+ (funcall ,bodysym)
+ ,@handlers))))))
+
;; `font-lock-add-keywords' does not exist in XEmacs.
(defun tramp-compat-font-lock-add-keywords (mode keywords &optional how)
"Add highlighting KEYWORDS for MODE."
@@ -312,43 +328,49 @@
;; `copy-directory' is a new function in Emacs 23.2. Implementation
;; is taken from there.
(defun tramp-compat-copy-directory
- (directory newname &optional keep-time parents)
+ (directory newname &optional keep-time parents copy-contents)
"Make a copy of DIRECTORY (compat function)."
- (if (fboundp 'copy-directory)
- (tramp-compat-funcall 'copy-directory directory newname keep-time
parents)
-
- ;; If `default-directory' is a remote directory, make sure we find
- ;; its `copy-directory' handler.
- (let ((handler (or (find-file-name-handler directory 'copy-directory)
- (find-file-name-handler newname 'copy-directory))))
- (if handler
- (funcall handler 'copy-directory directory newname keep-time parents)
-
- ;; Compute target name.
- (setq directory (directory-file-name (expand-file-name directory))
- newname (directory-file-name (expand-file-name newname)))
- (if (and (file-directory-p newname)
- (not (string-equal (file-name-nondirectory directory)
- (file-name-nondirectory newname))))
- (setq newname
- (expand-file-name
- (file-name-nondirectory directory) newname)))
- (if (not (file-directory-p newname)) (make-directory newname parents))
-
- ;; Copy recursively.
- (mapc
- (lambda (file)
- (if (file-directory-p file)
- (tramp-compat-copy-directory file newname keep-time parents)
- (copy-file file newname t keep-time)))
- ;; We do not want to delete "." and "..".
- (directory-files
- directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
-
- ;; Set directory attributes.
- (set-file-modes newname (file-modes directory))
- (if keep-time
- (set-file-times newname (nth 5 (file-attributes directory))))))))
+ (condition-case nil
+ (tramp-compat-funcall
+ 'copy-directory directory newname keep-time parents copy-contents)
+
+ ;; `copy-directory' is either not implemented, or it does not
+ ;; support the the COPY-CONTENTS flag. For the time being, we
+ ;; ignore COPY-CONTENTS as well.
+
+ (error
+ ;; If `default-directory' is a remote directory, make sure we
+ ;; find its `copy-directory' handler.
+ (let ((handler (or (find-file-name-handler directory 'copy-directory)
+ (find-file-name-handler newname 'copy-directory))))
+ (if handler
+ (funcall handler 'copy-directory directory newname keep-time parents)
+
+ ;; Compute target name.
+ (setq directory (directory-file-name (expand-file-name directory))
+ newname (directory-file-name (expand-file-name newname)))
+ (if (and (file-directory-p newname)
+ (not (string-equal (file-name-nondirectory directory)
+ (file-name-nondirectory newname))))
+ (setq newname
+ (expand-file-name
+ (file-name-nondirectory directory) newname)))
+ (if (not (file-directory-p newname)) (make-directory newname parents))
+
+ ;; Copy recursively.
+ (mapc
+ (lambda (file)
+ (if (file-directory-p file)
+ (tramp-compat-copy-directory file newname keep-time parents)
+ (copy-file file newname t keep-time)))
+ ;; We do not want to delete "." and "..".
+ (directory-files
+ directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
+
+ ;; Set directory attributes.
+ (set-file-modes newname (file-modes directory))
+ (if keep-time
+ (set-file-times newname (nth 5 (file-attributes directory)))))))))
;; TRASH has been introduced with Emacs 24.1.
(defun tramp-compat-delete-file (filename &optional trash)
=== modified file 'lisp/net/tramp-ftp.el'
--- a/lisp/net/tramp-ftp.el 2012-04-09 13:05:48 +0000
+++ b/lisp/net/tramp-ftp.el 2012-06-11 10:30:07 +0000
@@ -49,9 +49,8 @@
(defun tramp-disable-ange-ftp ()
"Turn Ange-FTP off.
This is useful for unified remoting. See
-`tramp-file-name-structure-unified' and
-`tramp-file-name-structure-separate' for details. Requests suitable
-for Ange-FTP will be forwarded to Ange-FTP. Also see the variables
+`tramp-file-name-structure' for details. Requests suitable for
+Ange-FTP will be forwarded to Ange-FTP. Also see the variables
`tramp-ftp-method', `tramp-default-method', and
`tramp-default-method-alist'.
@@ -204,8 +203,8 @@
;;;###tramp-autoload
(defsubst tramp-ftp-file-name-p (filename)
"Check if it's a filename that should be forwarded to Ange-FTP."
- (let ((v (tramp-dissect-file-name filename)))
- (string= (tramp-file-name-method v) tramp-ftp-method)))
+ (string= (tramp-file-name-method (tramp-dissect-file-name filename))
+ tramp-ftp-method))
;;;###tramp-autoload
(unless (featurep 'xemacs)
=== modified file 'lisp/net/tramp-gvfs.el'
--- a/lisp/net/tramp-gvfs.el 2012-04-09 13:05:48 +0000
+++ b/lisp/net/tramp-gvfs.el 2012-06-11 10:30:07 +0000
@@ -625,7 +625,7 @@
;; If there is a default location, expand tilde.
(when (string-match "\\`\\(~\\)\\(/\\|\\'\\)" localname)
(save-match-data
- (tramp-gvfs-maybe-open-connection (vector method user host "/")))
+ (tramp-gvfs-maybe-open-connection (vector method user host "/" hop)))
(setq localname
(replace-match
(tramp-get-file-property v "/" "default-location" "~")
=== modified file 'lisp/net/tramp-gw.el'
--- a/lisp/net/tramp-gw.el 2012-04-09 13:05:48 +0000
+++ b/lisp/net/tramp-gw.el 2012-06-11 10:30:07 +0000
@@ -154,7 +154,7 @@
(memq (process-status tramp-gw-aux-proc) '(listen)))
(let ((aux-vec
(vector "aux" (tramp-file-name-user gw-vec)
- (tramp-file-name-host gw-vec) nil)))
+ (tramp-file-name-host gw-vec) nil nil)))
(setq tramp-gw-aux-proc
(make-network-process
:name (tramp-buffer-name aux-vec) :buffer nil :host 'local
=== modified file 'lisp/net/tramp-sh.el'
--- a/lisp/net/tramp-sh.el 2012-06-06 13:32:36 +0000
+++ b/lisp/net/tramp-sh.el 2012-06-11 10:30:07 +0000
@@ -51,8 +51,9 @@
:type '(choice (const nil) integer))
(defcustom tramp-copy-size-limit 10240
- "The maximum file size where inline copying is preferred over an
out-of-the-band copy.
-If it is nil, inline out-of-the-band copy will be used without a check."
+ "The maximum file size where inline copying is preferred over an \
+out-of-the-band copy.
+If it is nil, out-of-the-band copy will be used without a check."
:group 'tramp
:type '(choice (const nil) integer))
@@ -347,7 +348,6 @@
(tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%h")))
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))
- (tramp-password-end-of-line "xy") ;see docstring for "xy"
(tramp-default-port 22)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
@@ -356,7 +356,6 @@
(tramp-login-args (("-l" "%u") ("-P" "%p") ("-1" "-ssh") ("%h")))
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))
- (tramp-password-end-of-line "xy") ;see docstring for "xy"
(tramp-default-port 22)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
@@ -384,7 +383,6 @@
("-q") ("-r")))
(tramp-copy-keep-date t)
(tramp-copy-recursive t)
- (tramp-password-end-of-line "xy") ;see docstring for "xy"
(tramp-default-port 22)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
@@ -397,8 +395,7 @@
(tramp-copy-args (("-l" "%u") ("-P" "%p") ("-sftp") ("-p" "%k")
("-q") ("-r")))
(tramp-copy-keep-date t)
- (tramp-copy-recursive t)
- (tramp-password-end-of-line "xy"))) ;see docstring for "xy"
+ (tramp-copy-recursive t)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
'("fcp"
@@ -462,9 +459,11 @@
;;;###tramp-autoload
(defconst tramp-completion-function-alist-putty
- '((tramp-parse-putty
- "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions"))
- "Default list of (FUNCTION REGISTRY) pairs to be examined for putty
methods.")
+ `((tramp-parse-putty
+ ,(if (memq system-type '(windows-nt))
+ "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions"
+ "~/.putty/sessions")))
+ "Default list of (FUNCTION REGISTRY) pairs to be examined for putty
sessions.")
;;;###tramp-autoload
(eval-after-load 'tramp
@@ -513,9 +512,10 @@
;; IRIX64: /usr/bin
;;;###tramp-autoload
(defcustom tramp-remote-path
- '(tramp-default-remote-path "/bin" "/usr/bin" "/usr/sbin" "/usr/local/bin"
- "/local/bin" "/local/freeware/bin" "/local/gnu/bin"
- "/usr/freeware/bin" "/usr/pkg/bin" "/usr/contrib/bin")
+ '(tramp-default-remote-path "/bin" "/usr/bin" "/usr/sbin"
+ "/usr/local/bin" "/local/bin" "/local/freeware/bin" "/local/gnu/bin"
+ "/usr/freeware/bin" "/usr/pkg/bin" "/usr/contrib/bin"
+ "/opt/bin" "/opt/sbin" "/opt/local/bin")
"List of directories to search for executables on remote host.
For every remote host, this variable will be set buffer local,
keeping the list of existing directories on that host.
@@ -545,7 +545,6 @@
,(format "INSIDE_EMACS='%s,tramp:%s'" emacs-version tramp-version)
"CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH=" "PAGER=\"\""
"autocorrect=" "correct=")
-
"List of environment variables to be set on the remote host.
Each element should be a string of the form ENVVARNAME=VALUE. An
@@ -1180,9 +1179,6 @@
(tramp-get-file-exists-command v)
(tramp-shell-quote-argument localname)))))))
-;; CCC: This should check for an error condition and signal failure
-;; when something goes wrong.
-;; Daniel Pittman <address@hidden>
(defun tramp-sh-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
(unless id-format (setq id-format 'integer))
@@ -1318,8 +1314,8 @@
(tramp-get-test-command vec)
(tramp-shell-quote-argument localname)
(tramp-get-remote-stat vec)
- (if (eq id-format 'integer) "%u" "\"%U\"")
- (if (eq id-format 'integer) "%g" "\"%G\"")
+ (if (eq id-format 'integer) "%ue0" "\"%U\"")
+ (if (eq id-format 'integer) "%ge0" "\"%G\"")
(tramp-shell-quote-argument localname))))
(defun tramp-sh-handle-set-visited-file-modtime (&optional time-list)
@@ -1702,8 +1698,8 @@
(tramp-shell-quote-argument localname)
(tramp-get-ls-command vec)
(tramp-get-remote-stat vec)
- (if (eq id-format 'integer) "%u" "\"%U\"")
- (if (eq id-format 'integer) "%g" "\"%G\""))))
+ (if (eq id-format 'integer) "%ue0" "\"%U\"")
+ (if (eq id-format 'integer) "%ge0" "\"%G\""))))
;; This function should return "foo/" for directories and "bar" for
;; files.
@@ -2394,7 +2390,7 @@
p v nil tramp-actions-copy-out-of-band)))
;; Reset the transfer process properties.
- (tramp-message orig-vec 6 "%s" (buffer-string))
+ (tramp-message orig-vec 6 "\n%s" (buffer-string))
(tramp-set-connection-property v "process-name" nil)
(tramp-set-connection-property v "process-buffer" nil)))
@@ -2457,11 +2453,11 @@
"Recursively delete the directory given.
This is like `dired-recursive-delete-directory' for Tramp files."
(with-parsed-tramp-file-name filename nil
- ;; Run a shell command 'rm -r <localname>'
+ ;; Run a shell command 'rm -r <localname>'.
;; Code shamelessly stolen from the dired implementation and, um, hacked :)
(unless (file-exists-p filename)
(tramp-error v 'file-error "No such directory: %s" filename))
- ;; Which is better, -r or -R? (-r works for me <address@hidden>)
+ ;; Which is better, -r or -R? (-r works for me <address@hidden>).
(tramp-send-command
v
(format "rm -rf %s" (tramp-shell-quote-argument localname))
@@ -2699,7 +2695,8 @@
method user host
(tramp-drop-volume-letter
(tramp-run-real-handler
- 'expand-file-name (list localname))))))))
+ 'expand-file-name (list localname)))
+ hop)))))
;;; Remote commands:
@@ -3609,37 +3606,48 @@
(defun tramp-find-shell (vec)
"Opens a shell on the remote host which groks tilde expansion."
- (unless (tramp-get-connection-property vec "remote-shell" nil)
- (let (shell)
+ (with-connection-property vec "remote-shell"
+ (let ((shell (tramp-get-method-parameter
+ (tramp-file-name-method vec) 'tramp-remote-shell)))
(with-current-buffer (tramp-get-buffer vec)
+ ;; CCC: "root" does not exist always, see QNAP 459. Which
+ ;; check could we apply instead?
(tramp-send-command vec "echo ~root" t)
- (cond
- ((or (string-match "^~root$" (buffer-string))
- ;; The default shell (ksh93) of OpenSolaris and Solaris
- ;; is buggy. We've got reports for "SunOS 5.10" and
- ;; "SunOS 5.11" so far.
- (string-match (regexp-opt '("SunOS 5.10" "SunOS 5.11"))
- (tramp-get-connection-property vec "uname" "")))
- (setq shell
- (or (tramp-find-executable
- vec "bash" (tramp-get-remote-path vec) t t)
- (tramp-find-executable
- vec "ksh" (tramp-get-remote-path vec) t t)))
- (unless shell
- (tramp-error
- vec 'file-error
- "Couldn't find a shell which groks tilde expansion"))
- (tramp-message
- vec 5 "Starting remote shell `%s' for tilde expansion"
- (tramp-set-connection-property vec "remote-shell" shell))
- (tramp-open-shell vec shell))
-
- (t (tramp-message
- vec 5 "Remote `%s' groks tilde expansion, good"
- (tramp-set-connection-property
- vec "remote-shell"
- (tramp-get-method-parameter
- (tramp-file-name-method vec) 'tramp-remote-shell)))))))))
+ (when (or (string-match "^~root$" (buffer-string))
+ ;; The default shell (ksh93) of OpenSolaris and
+ ;; Solaris is buggy. We've got reports for "SunOS
+ ;; 5.10" and "SunOS 5.11" so far.
+ (string-match (regexp-opt '("SunOS 5.10" "SunOS 5.11"))
+ (tramp-get-connection-property vec "uname" "")))
+ (if (setq shell
+ (or (tramp-find-executable
+ vec "bash" (tramp-get-remote-path vec) t t)
+ (tramp-find-executable
+ vec "ksh" (tramp-get-remote-path vec) t t)))
+ (progn
+ (tramp-message
+ vec 5 "Starting remote shell `%s' for tilde expansion" shell)
+ (tramp-open-shell vec shell))
+
+ ;; Maybe it works at least for some other commands.
+ (setq shell
+ (tramp-get-method-parameter
+ (tramp-file-name-method vec) 'tramp-remote-shell))
+ (tramp-message
+ vec 2
+ (concat
+ "Couldn't find a remote shell which groks tilde expansion, "
+ "using `%s'")
+ shell)))
+
+ ;; Busyboxes tend to behave strange. We check for the existence.
+ (with-connection-property vec "busybox"
+ (tramp-send-command vec (format "%s --version" shell) t)
+ (let ((case-fold-search t))
+ (and (string-match "busybox" (buffer-string)) t)))
+
+ ;; Return the shell.
+ shell))))
;; Utility functions.
@@ -3747,21 +3755,12 @@
vec "uname"
(tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\""))))
(when (and (stringp old-uname) (not (string-equal old-uname new-uname)))
- (with-current-buffer (tramp-get-debug-buffer vec)
- ;; Keep the debug buffer.
- (rename-buffer
- (generate-new-buffer-name tramp-temp-buffer-name) 'unique)
- (tramp-cleanup-connection vec)
- (if (= (point-min) (point-max))
- (kill-buffer nil)
- (rename-buffer (tramp-debug-buffer-name vec) 'unique))
- ;; We call `tramp-get-buffer' in order to keep the debug buffer.
- (tramp-get-buffer vec)
- (tramp-message
- vec 3
- "Connection reset, because remote host changed from `%s' to `%s'"
- old-uname new-uname)
- (throw 'uname-changed (tramp-maybe-open-connection vec)))))
+ (tramp-cleanup vec)
+ (tramp-message
+ vec 3
+ "Connection reset, because remote host changed from `%s' to `%s'"
+ old-uname new-uname)
+ (throw 'uname-changed (tramp-maybe-open-connection vec))))
;; Check whether the remote host suffers from buggy
;; `send-process-string'. This is known for FreeBSD (see comment in
@@ -3798,17 +3797,6 @@
;; Disable unexpected output.
(tramp-send-command vec "mesg n; biff n" t)
- ;; Busyboxes tend to behave strange. We check for the existence.
- (with-connection-property vec "busybox"
- (tramp-send-command
- vec
- (format
- "%s --version" (tramp-get-connection-property vec "remote-shell" "echo"))
- t)
- (with-current-buffer (process-buffer proc)
- (let ((case-fold-search t))
- (and (string-match "busybox" (buffer-string)) t))))
-
;; IRIX64 bash expands "!" even when in single quotes. This
;; destroys our shell functions, we must disable it. See
;;
<http://stackoverflow.com/questions/3291692/irix-bash-shell-expands-expression-in-single-quotes-yet-shouldnt>.
@@ -3902,7 +3890,7 @@
(b64 "recode data..base64" "recode base64..data")
(b64 tramp-perl-encode-with-module tramp-perl-decode-with-module)
(b64 tramp-perl-encode tramp-perl-decode)
- (uu "uuencode xxx" "uudecode -o /dev/stdout")
+ (uu "uuencode xxx" "uudecode -o /dev/stdout" "test -c /dev/stdout")
(uu "uuencode xxx" "uudecode -o -")
(uu "uuencode xxx" "uudecode -p")
(uu "uuencode xxx" tramp-uudecode)
@@ -3912,7 +3900,7 @@
"List of remote coding commands for inline transfer.
Each item is a list that looks like this:
-\(FORMAT ENCODING DECODING\)
+\(FORMAT ENCODING DECODING [TEST]\)
FORMAT is symbol describing the encoding/decoding format. It can be
`b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing.
@@ -3926,7 +3914,10 @@
If they are variables, this variable is a string containing a Perl
implementation for this functionality. This Perl program will be transferred
-to the remote host, and it is available as shell function with the same name.")
+to the remote host, and it is available as shell function with the same name.
+
+The optional TEST command can be used for further tests, whether
+ENCODING and DECODING are applicable.")
(defun tramp-find-inline-encoding (vec)
"Find an inline transfer encoding that works.
@@ -3935,7 +3926,8 @@
(save-excursion
(let ((local-commands tramp-local-coding-commands)
(magic "xyzzy")
- loc-enc loc-dec rem-enc rem-dec litem ritem found)
+ (p (tramp-get-connection-process vec))
+ loc-enc loc-dec rem-enc rem-dec rem-test litem ritem found)
(while (and local-commands (not found))
(setq litem (pop local-commands))
(catch 'wont-work-local
@@ -3968,6 +3960,13 @@
(when (equal format (nth 0 ritem))
(setq rem-enc (nth 1 ritem))
(setq rem-dec (nth 2 ritem))
+ (setq rem-test (nth 3 ritem))
+ ;; Check the remote test command if exists.
+ (when (stringp rem-test)
+ (tramp-message
+ vec 5 "Checking remote test command `%s'" rem-test)
+ (unless (tramp-send-command-and-check vec rem-test t)
+ (throw 'wont-work-remote nil)))
;; Check if remote encoding and decoding commands can be
;; called remotely with null input and output. This makes
;; sure there are no syntax errors and the command is really
@@ -4019,15 +4018,16 @@
(tramp-error
vec 'file-error "Couldn't find an inline transfer encoding"))
- ;; Set connection properties.
+ ;; Set connection properties. Since the commands are risky (due
+ ;; to output direction), we cache them in the process cache.
(tramp-message vec 5 "Using local encoding `%s'" loc-enc)
- (tramp-set-connection-property vec "local-encoding" loc-enc)
+ (tramp-set-connection-property p "local-encoding" loc-enc)
(tramp-message vec 5 "Using local decoding `%s'" loc-dec)
- (tramp-set-connection-property vec "local-decoding" loc-dec)
+ (tramp-set-connection-property p "local-decoding" loc-dec)
(tramp-message vec 5 "Using remote encoding `%s'" rem-enc)
- (tramp-set-connection-property vec "remote-encoding" rem-enc)
+ (tramp-set-connection-property p "remote-encoding" rem-enc)
(tramp-message vec 5 "Using remote decoding `%s'" rem-dec)
- (tramp-set-connection-property vec "remote-decoding" rem-dec))))
+ (tramp-set-connection-property p "remote-decoding" rem-dec))))
(defun tramp-call-local-coding-command (cmd input output)
"Call the local encoding or decoding command.
@@ -4065,8 +4065,8 @@
(save-excursion
(let ((commands tramp-inline-compress-commands)
(magic "xyzzy")
- item compress decompress
- found)
+ (p (tramp-get-connection-process vec))
+ item compress decompress found)
(while (and commands (not found))
(catch 'next
(setq item (pop commands)
@@ -4100,16 +4100,18 @@
;; Did we find something?
(if found
(progn
- ;; Set connection properties.
+ ;; Set connection properties. Since the commands are
+ ;; risky (due to output direction), we cache them in the
+ ;; process cache.
(tramp-message
vec 5 "Using inline transfer compress command `%s'" compress)
- (tramp-set-connection-property vec "inline-compress" compress)
+ (tramp-set-connection-property p "inline-compress" compress)
(tramp-message
vec 5 "Using inline transfer decompress command `%s'" decompress)
- (tramp-set-connection-property vec "inline-decompress" decompress))
+ (tramp-set-connection-property p "inline-decompress" decompress))
- (tramp-set-connection-property vec "inline-compress" nil)
- (tramp-set-connection-property vec "inline-decompress" nil)
+ (tramp-set-connection-property p "inline-compress" nil)
+ (tramp-set-connection-property p "inline-decompress" nil)
(tramp-message
vec 2 "Couldn't find an inline transfer compress command")))))
@@ -4117,18 +4119,43 @@
"Expands VEC according to `tramp-default-proxies-alist'.
Gateway hops are already opened."
(let ((target-alist `(,vec))
- (choices tramp-default-proxies-alist)
- item proxy)
+ (hops (or (tramp-file-name-hop vec) ""))
+ (item vec)
+ choices proxy)
+
+ ;; Ad-hoc proxy definitions.
+ (dolist (proxy (reverse (split-string hops tramp-postfix-hop-regexp
'omit)))
+ (let ((user (tramp-file-name-user item))
+ (host (tramp-file-name-host item))
+ (proxy (concat
+ tramp-prefix-format proxy tramp-postfix-host-format)))
+ (tramp-message
+ vec 5 "Add proxy (\"%s\" \"%s\" \"%s\")"
+ (and (stringp host) (regexp-quote host))
+ (and (stringp user) (regexp-quote user))
+ proxy)
+ ;; Add the hop.
+ (add-to-list
+ 'tramp-default-proxies-alist
+ (list (and (stringp host) (regexp-quote host))
+ (and (stringp user) (regexp-quote user))
+ proxy))
+ (setq item (tramp-dissect-file-name proxy))))
+ ;; Save the new value.
+ (when (and hops tramp-save-ad-hoc-proxies)
+ (customize-save-variable
+ 'tramp-default-proxies-alist tramp-default-proxies-alist))
;; Look for proxy hosts to be passed.
+ (setq choices tramp-default-proxies-alist)
(while choices
(setq item (pop choices)
proxy (eval (nth 2 item)))
(when (and
- ;; host
+ ;; Host.
(string-match (or (eval (nth 0 item)) "")
(or (tramp-file-name-host (car target-alist)) ""))
- ;; user
+ ;; User.
(string-match (or (eval (nth 1 item)) "")
(or (tramp-file-name-user (car target-alist)) "")))
(if (null proxy)
@@ -4164,7 +4191,7 @@
'target-alist
(vector
(tramp-file-name-method hop) (tramp-file-name-user hop)
- (tramp-compat-funcall 'tramp-gw-open-connection vec gw hop) nil))
+ (tramp-compat-funcall 'tramp-gw-open-connection vec gw hop) nil nil))
;; For the password prompt, we need the correct values.
;; Therefore, we must remember the gateway vector. But we
;; cannot do it as connection property, because it shouldn't
@@ -4212,6 +4239,9 @@
;; Result.
target-alist))
+(defvar tramp-current-connection nil
+ "Last connection timestamp.")
+
(defun tramp-maybe-open-connection (vec)
"Maybe open a connection VEC.
Does not do anything if a connection is already open, but re-opens the
@@ -4222,6 +4252,16 @@
(process-environment (copy-sequence process-environment))
(pos (with-current-buffer (tramp-get-connection-buffer vec) (point))))
+ ;; If Tramp opens the same connection within a short time frame,
+ ;; there is a problem. We shall signal this.
+ (unless (or (and p (processp p) (memq (process-status p) '(run open)))
+ (not (equal (butlast (append vec nil))
+ (car tramp-current-connection)))
+ (> (tramp-time-diff
+ (current-time) (cdr tramp-current-connection))
+ 5))
+ (throw 'suppress 'suppress))
+
;; If too much time has passed since last command was sent, look
;; whether process is still alive. If it isn't, kill it. When
;; using ssh, it can sometimes happen that the remote end has
@@ -4242,9 +4282,7 @@
;; The error will be caught locally.
(tramp-error vec 'file-error "Awake did fail")))
(file-error
- (tramp-flush-connection-property vec)
- (tramp-flush-connection-property p)
- (delete-process p)
+ (tramp-cleanup vec)
(setq p nil)))
;; New connection must be opened.
@@ -4293,6 +4331,8 @@
(tramp-set-connection-property p "vector" vec)
(set-process-sentinel p 'tramp-process-sentinel)
(tramp-compat-set-process-query-on-exit-flag p nil)
+ (setq tramp-current-connection
+ (cons (butlast (append vec nil)) (current-time)))
(tramp-message
vec 6 "%s" (mapconcat 'identity (process-command p) " "))
@@ -4401,11 +4441,7 @@
;; When the user did interrupt, we must cleanup.
(quit
- (let ((p (tramp-get-connection-process vec)))
- (when (and p (processp p))
- (tramp-flush-connection-property vec)
- (tramp-flush-connection-property p)
- (delete-process p)))
+ (tramp-cleanup vec)
;; Propagate the quit signal.
(signal (car err) (cdr err)))))))
@@ -4942,9 +4978,10 @@
If no corresponding command is found, nil is returned."
(when (and (integerp tramp-inline-compress-start-size)
(> size tramp-inline-compress-start-size))
- (with-connection-property vec prop
+ (with-connection-property (tramp-get-connection-process vec) prop
(tramp-find-inline-compress vec)
- (tramp-get-connection-property vec prop nil))))
+ (tramp-get-connection-property
+ (tramp-get-connection-process vec) prop nil))))
(defun tramp-get-inline-coding (vec prop size)
"Return the coding command related to PROP.
@@ -4962,9 +4999,10 @@
;; no inline coding is found.
(ignore-errors
(let ((coding
- (with-connection-property vec prop
+ (with-connection-property (tramp-get-connection-process vec) prop
(tramp-find-inline-encoding vec)
- (tramp-get-connection-property vec prop nil)))
+ (tramp-get-connection-property
+ (tramp-get-connection-process vec) prop nil)))
(prop1 (if (string-match "encoding" prop)
"inline-compress" "inline-decompress"))
compress)
=== modified file 'lisp/net/tramp-smb.el'
--- a/lisp/net/tramp-smb.el 2012-04-09 13:05:48 +0000
+++ b/lisp/net/tramp-smb.el 2012-06-11 10:30:07 +0000
@@ -43,7 +43,7 @@
;; We define an empty command, because `tramp-smb-call-winexe'
;; opens already the powershell. Used in `tramp-handle-shell-command'.
(tramp-remote-shell "")
- ;; This is just a guess. We don't know whether the share "$C"
+ ;; This is just a guess. We don't know whether the share "C$"
;; is available for public use, and whether the user has write
;; access.
(tramp-tmpdir "/C$/Temp"))))
@@ -82,8 +82,18 @@
(defvar tramp-smb-version nil
"Version string of the SMB client.")
-(defconst tramp-smb-prompt "^smb: .+> \\|^\\s-+Server\\s-+Comment$"
- "Regexp used as prompt in smbclient.")
+(defconst tramp-smb-server-version
+ "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]"
+ "Regexp of SMB server identification.")
+
+(defconst tramp-smb-prompt "^\\(smb:\\|PS\\) .+> \\|^\\s-+Server\\s-+Comment$"
+ "Regexp used as prompt in smbclient or powershell.")
+
+(defconst tramp-smb-wrong-passwd-regexp
+ (regexp-opt
+ '("NT_STATUS_LOGON_FAILURE"
+ "NT_STATUS_WRONG_PASSWORD"))
+ "Regexp for login error strings of SMB servers.")
(defconst tramp-smb-errors
(mapconcat
@@ -155,6 +165,16 @@
See `tramp-actions-before-shell' for more info.")
+(defconst tramp-smb-actions-with-tar
+ '((tramp-password-prompt-regexp tramp-action-password)
+ (tramp-wrong-passwd-regexp tramp-action-permission-denied)
+ (tramp-smb-errors tramp-action-permission-denied)
+ (tramp-process-alive-regexp tramp-smb-action-with-tar))
+ "List of pattern/action pairs.
+This list is used for tar-like copy of directories.
+
+See `tramp-actions-before-shell' for more info.")
+
;; New handlers should be added here.
(defconst tramp-smb-file-name-handler-alist
'(
@@ -205,12 +225,14 @@
(make-directory . tramp-smb-handle-make-directory)
(make-directory-internal . tramp-smb-handle-make-directory-internal)
(make-symbolic-link . tramp-smb-handle-make-symbolic-link)
+ (process-file . tramp-smb-handle-process-file)
(rename-file . tramp-smb-handle-rename-file)
(set-file-modes . tramp-smb-handle-set-file-modes)
;; `set-file-selinux-context' performed by default handler.
(set-file-times . ignore)
(set-visited-file-modtime . ignore)
- (shell-command . ignore)
+ (shell-command . tramp-handle-shell-command)
+ (start-file-process . tramp-smb-handle-start-file-process)
(substitute-in-file-name . tramp-smb-handle-substitute-in-file-name)
(unhandled-file-name-directory .
tramp-handle-unhandled-file-name-directory)
(vc-registered . ignore)
@@ -220,11 +242,34 @@
"Alist of handler functions for Tramp SMB method.
Operations not mentioned here will be handled by the default Emacs
primitives.")
+;; Options for remote processes via winexe.
+(defcustom tramp-smb-winexe-program "winexe"
+ "Name of winexe client to run.
+If it isn't found in the local $PATH, the absolute path of winexe
+shall be given. This is needed for remote processes."
+ :group 'tramp
+ :type 'string
+ :version "24.2")
+
+(defcustom tramp-smb-winexe-shell-command "powershell.exe"
+ "Shell to be used for processes on remote machines.
+This must be Powershell V2 compatible."
+ :group 'tramp
+ :type 'string
+ :version "24.2")
+
+(defcustom tramp-smb-winexe-shell-command-switch "-file -"
+ "Command switch used together with `tramp-smb-winexe-shell-command'.
+This can be used to disable echo etc."
+ :group 'tramp
+ :type 'string
+ :version "24.2")
+
;;;###tramp-autoload
(defsubst tramp-smb-file-name-p (filename)
"Check if it's a filename for SMB servers."
- (let ((v (tramp-dissect-file-name filename)))
- (string= (tramp-file-name-method v) tramp-smb-method)))
+ (string= (tramp-file-name-method (tramp-dissect-file-name filename))
+ tramp-smb-method))
;;;###tramp-autoload
(defun tramp-smb-file-name-handler (operation &rest args)
@@ -287,14 +332,31 @@
"error with add-name-to-file, see buffer `%s' for details"
(buffer-name))))))
+(defun tramp-smb-action-with-tar (proc vec)
+ "Untar from connection buffer."
+ (if (not (memq (process-status proc) '(run open)))
+ (throw 'tramp-action 'process-died)
+
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (goto-char (point-min))
+ (when (search-forward-regexp tramp-smb-server-version nil t)
+ ;; There might be a hidden password prompt.
+ (widen)
+ (forward-line)
+ (tramp-message vec 6 (buffer-substring (point-min) (point)))
+ (delete-region (point-min) (point))
+ (throw 'tramp-action 'ok)))))
+
(defun tramp-smb-handle-copy-directory
(dirname newname &optional keep-date parents copy-contents)
- "Like `copy-directory' for Tramp files. KEEP-DATE is not handled."
+ "Like `copy-directory' for Tramp files."
(setq dirname (expand-file-name dirname)
newname (expand-file-name newname))
(let ((t1 (tramp-tramp-file-p dirname))
(t2 (tramp-tramp-file-p newname)))
(with-parsed-tramp-file-name (if t1 dirname newname) nil
+ (tramp-with-progress-reporter
+ v 0 (format "Copying %s to %s" dirname newname)
(cond
;; We must use a local temporary directory.
((and t1 t2)
@@ -311,46 +373,121 @@
;; We can copy recursively.
((or t1 t2)
- (let ((prompt (tramp-smb-send-command v "prompt"))
- (recurse (tramp-smb-send-command v "recurse")))
- (unless (file-directory-p newname)
+ (when (and (file-directory-p newname)
+ (not (string-equal (file-name-nondirectory dirname)
+ (file-name-nondirectory newname))))
+ (setq newname
+ (expand-file-name
+ (file-name-nondirectory dirname) newname))
+ (if t2 (setq v (tramp-dissect-file-name newname))))
+ (if (not (file-directory-p newname))
(make-directory newname parents))
+
+ (setq tramp-current-method (tramp-file-name-method v)
+ tramp-current-user (tramp-file-name-user v)
+ tramp-current-host (tramp-file-name-real-host v))
+
+ (let* ((real-user (tramp-file-name-real-user v))
+ (real-host (tramp-file-name-real-host v))
+ (domain (tramp-file-name-domain v))
+ (port (tramp-file-name-port v))
+ (share (tramp-smb-get-share v))
+ (localname (file-name-as-directory
+ (replace-regexp-in-string
+ "\\\\" "/" (tramp-smb-get-localname v))))
+ (tmpdir (make-temp-name
+ (expand-file-name
+ tramp-temp-name-prefix
+ (tramp-compat-temporary-file-directory))))
+ (args (list tramp-smb-program
+ (concat "//" real-host "/" share) "-E")))
+
+ (if (not (zerop (length real-user)))
+ (setq args (append args (list "-U" real-user)))
+ (setq args (append args (list "-N"))))
+
+ (when domain (setq args (append args (list "-W" domain))))
+ (when port (setq args (append args (list "-p" port))))
+ (when tramp-smb-conf
+ (setq args (append args (list "-s" tramp-smb-conf))))
+ (setq args
+ (if t1
+ ;; Source is remote.
+ (append args
+ (list "-D" (shell-quote-argument localname)
+ "-c" (shell-quote-argument "tar qc - *")
+ "|" "tar" "xfC" "-"
+ (shell-quote-argument tmpdir)))
+ ;; Target is remote.
+ (append (list "tar" "cfC" "-" (shell-quote-argument dirname)
+ "." "|")
+ args
+ (list "-D" (shell-quote-argument localname)
+ "-c" (shell-quote-argument "tar qx -")))))
+
(unwind-protect
- (unless
- (and
- prompt recurse
- (tramp-smb-send-command
- v (format "cd \"%s\"" (tramp-smb-get-localname v)))
- (tramp-smb-send-command
- v (format "lcd \"%s\"" (if t1 newname dirname)))
- (if t1
- (tramp-smb-send-command v "mget *")
- (tramp-smb-send-command v "mput *")))
- ;; Error.
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (search-forward-regexp tramp-smb-errors nil t)
- (tramp-error
- v 'file-error
- "%s `%s'" (match-string 0) (if t1 dirname newname))))
- ;; Go home.
- (tramp-smb-send-command
- v (format
- "cd %s" (if (tramp-smb-get-cifs-capabilities v) "/" "\\")))
- ;; Toggle prompt and recurse OFF.
- (if prompt (tramp-smb-send-command v "prompt"))
- (if recurse (tramp-smb-send-command v "recurse")))))
+ (with-temp-buffer
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+
+ (when t1
+ ;; The smbclient tar command creates always complete
+ ;; paths. We must emulate the directory structure,
+ ;; and symlink to the real target.
+ (make-directory
+ (expand-file-name ".." (concat tmpdir localname)) 'parents)
+ (make-symbolic-link
+ newname (directory-file-name (concat tmpdir localname))))
+
+ ;; Use an asynchronous processes. By this, password
+ ;; can be handled.
+ (let* ((default-directory tmpdir)
+ (p (start-process-shell-command
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ (mapconcat 'identity args " "))))
+
+ (tramp-message
+ v 6 "%s" (mapconcat 'identity (process-command p) " "))
+ (tramp-compat-set-process-query-on-exit-flag p nil)
+ (tramp-process-actions p v nil tramp-smb-actions-with-tar)
+
+ (while (memq (process-status p) '(run open))
+ (sit-for 0.1))
+ (tramp-message v 6 "\n%s" (buffer-string))))
+
+ ;; Reset the transfer process properties.
+ (tramp-set-connection-property v "process-name" nil)
+ (tramp-set-connection-property v "process-buffer" nil)
+ (when t1 (delete-directory tmpdir 'recurse))))
+
+ ;; Handle KEEP-DATE argument.
+ (when keep-date
+ (set-file-times newname (nth 5 (file-attributes dirname))))
+
+ ;; Set the mode.
+ (unless keep-date
+ (set-file-modes newname (tramp-default-file-modes dirname)))
+
+ ;; When newname did exist, we have wrong cached values.
+ (when t2
+ (with-parsed-tramp-file-name newname nil
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-file-property v localname))))
;; We must do it file-wise.
(t
(tramp-run-real-handler
- 'copy-directory (list dirname newname keep-date parents)))))))
+ 'copy-directory (list dirname newname keep-date parents))))))))
(defun tramp-smb-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
preserve-uid-gid preserve-selinux-context)
"Like `copy-file' for Tramp files.
-KEEP-DATE is not handled in case NEWNAME resides on an SMB server.
+KEEP-DATE has no effect in case NEWNAME resides on an SMB server.
PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored."
(setq filename (expand-file-name filename)
newname (expand-file-name newname))
@@ -358,40 +495,43 @@
(tramp-dissect-file-name (if (file-remote-p filename) filename newname))
0 (format "Copying %s to %s" filename newname)
- (let ((tmpfile (file-local-copy filename)))
-
- (if tmpfile
- ;; Remote filename.
- (condition-case err
- (rename-file tmpfile newname ok-if-already-exists)
- ((error quit)
- (delete-file tmpfile)
- (signal (car err) (cdr err))))
-
- ;; Remote newname.
- (when (file-directory-p newname)
- (setq newname
- (expand-file-name (file-name-nondirectory filename) newname)))
-
- (with-parsed-tramp-file-name newname nil
- (when (and (not ok-if-already-exists)
- (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
-
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-file-property v localname)
- (unless (tramp-smb-get-share v)
- (tramp-error
- v 'file-error "Target `%s' must contain a share name" newname))
- (unless (tramp-smb-send-command
- v (format "put \"%s\" \"%s\""
- filename (tramp-smb-get-localname v)))
- (tramp-error v 'file-error "Cannot copy `%s'" filename))))))
-
- ;; KEEP-DATE handling.
- (when keep-date (set-file-times newname (nth 5 (file-attributes filename)))))
+ (if (file-directory-p filename)
+ (tramp-compat-copy-directory filename newname keep-date t t)
+
+ (let ((tmpfile (file-local-copy filename)))
+ (if tmpfile
+ ;; Remote filename.
+ (condition-case err
+ (rename-file tmpfile newname ok-if-already-exists)
+ ((error quit)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err))))
+
+ ;; Remote newname.
+ (when (file-directory-p newname)
+ (setq newname
+ (expand-file-name (file-name-nondirectory filename) newname)))
+
+ (with-parsed-tramp-file-name newname nil
+ (when (and (not ok-if-already-exists)
+ (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-file-property v localname)
+ (unless (tramp-smb-get-share v)
+ (tramp-error
+ v 'file-error "Target `%s' must contain a share name" newname))
+ (unless (tramp-smb-send-command
+ v (format "put \"%s\" \"%s\""
+ filename (tramp-smb-get-localname v)))
+ (tramp-error v 'file-error "Cannot copy `%s'" filename))))))
+
+ ;; KEEP-DATE handling.
+ (when keep-date
+ (set-file-times newname (nth 5 (file-attributes filename))))))
(defun tramp-smb-handle-delete-directory (directory &optional recursive)
"Like `delete-directory' for Tramp files."
@@ -539,7 +679,7 @@
"Implement `file-attributes' for Tramp files using stat command."
(tramp-message
vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec))
- (with-current-buffer (tramp-get-buffer vec)
+ (with-current-buffer (tramp-get-connection-buffer vec)
(let* (size id link uid gid atime mtime ctime mode inode)
(when (tramp-smb-send-command
vec (format "stat \"%s\"" (tramp-smb-get-localname vec)))
@@ -845,44 +985,170 @@
"error with make-symbolic-link, see buffer `%s' for details"
(buffer-name))))))
+(defun tramp-smb-handle-process-file
+ (program &optional infile destination display &rest args)
+ "Like `process-file' for Tramp files."
+ ;; The implementation is not complete yet.
+ (when (and (numberp destination) (zerop destination))
+ (error "Implementation does not handle immediate return"))
+
+ (with-parsed-tramp-file-name default-directory nil
+ (let* ((name (file-name-nondirectory program))
+ (name1 name)
+ (i 0)
+ input tmpinput outbuf command ret)
+
+ ;; Determine input.
+ (when infile
+ (setq infile (expand-file-name infile))
+ (if (tramp-equal-remote default-directory infile)
+ ;; INFILE is on the same remote host.
+ (setq input (with-parsed-tramp-file-name infile nil localname))
+ ;; INFILE must be copied to remote host.
+ (setq input (tramp-make-tramp-temp-file v)
+ tmpinput (tramp-make-tramp-file-name method user host input))
+ (copy-file infile tmpinput t))
+ ;; Transform input into a filename powershell does understand.
+ (setq input (format "//%s%s" host input)))
+
+ ;; Determine output.
+ (cond
+ ;; Just a buffer.
+ ((bufferp destination)
+ (setq outbuf destination))
+ ;; A buffer name.
+ ((stringp destination)
+ (setq outbuf (get-buffer-create destination)))
+ ;; (REAL-DESTINATION ERROR-DESTINATION)
+ ((consp destination)
+ ;; output.
+ (cond
+ ((bufferp (car destination))
+ (setq outbuf (car destination)))
+ ((stringp (car destination))
+ (setq outbuf (get-buffer-create (car destination))))
+ ((car destination)
+ (setq outbuf (current-buffer))))
+ ;; stderr.
+ (tramp-message v 2 "%s" "STDERR not supported"))
+ ;; 't
+ (destination
+ (setq outbuf (current-buffer))))
+
+ ;; Construct command.
+ (setq command (mapconcat 'identity (cons program args) " ")
+ command (if input
+ (format
+ "get-content %s | & %s"
+ (tramp-smb-shell-quote-argument input) command)
+ (format "& %s" command)))
+
+ (while (get-process name1)
+ ;; NAME must be unique as process name.
+ (setq i (1+ i)
+ name1 (format "%s<%d>" name i)))
+
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name1)
+ (tramp-set-connection-property
+ v "process-buffer"
+ (or outbuf (generate-new-buffer tramp-temp-buffer-name)))
+
+ ;; Call it.
+ (condition-case nil
+ (with-current-buffer (tramp-get-connection-buffer v)
+ ;; Preserve buffer contents.
+ (narrow-to-region (point-max) (point-max))
+ (tramp-smb-call-winexe v)
+ (when (tramp-smb-get-share v)
+ (tramp-smb-send-command
+ v (format "cd \"//%s%s\"" host (file-name-directory localname))))
+ (tramp-smb-send-command v command)
+ ;; Preserve command output.
+ (narrow-to-region (point-max) (point-max))
+ (let ((p (tramp-get-connection-process v)))
+ (tramp-smb-send-command v "exit $lasterrorcode")
+ (while (memq (process-status p) '(run open))
+ (sleep-for 0.1)
+ (setq ret (process-exit-status p))))
+ (delete-region (point-min) (point-max))
+ (widen))
+
+ ;; When the user did interrupt, we should do it also. We use
+ ;; return code -1 as marker.
+ (quit
+ (setq ret -1))
+ ;; Handle errors.
+ (error
+ (setq ret 1)))
+
+ ;; We should show the output anyway.
+ (when (and outbuf display) (display-buffer outbuf))
+
+ ;; Cleanup. We remove all file cache values for the connection,
+ ;; because the remote process could have changed them.
+ (tramp-set-connection-property v "process-name" nil)
+ (tramp-set-connection-property v "process-buffer" nil)
+ (when tmpinput (delete-file tmpinput))
+ (unless outbuf
+ (kill-buffer (tramp-get-connection-property v "process-buffer" nil)))
+
+ ;; `process-file-side-effects' has been introduced with GNU
+ ;; Emacs 23.2. If set to `nil', no remote file will be changed
+ ;; by `program'. If it doesn't exist, we assume its default
+ ;; value `t'.
+ (unless (and (boundp 'process-file-side-effects)
+ (not (symbol-value 'process-file-side-effects)))
+ (tramp-flush-directory-property v ""))
+
+ ;; Return exit status.
+ (if (equal ret -1)
+ (keyboard-quit)
+ ret))))
+
(defun tramp-smb-handle-rename-file
(filename newname &optional ok-if-already-exists)
"Like `rename-file' for Tramp files."
(setq filename (expand-file-name filename)
newname (expand-file-name newname))
+
+ (when (and (not ok-if-already-exists)
+ (file-exists-p newname))
+ (tramp-error
+ (tramp-dissect-file-name
+ (if (file-remote-p filename) filename newname))
+ 'file-already-exists newname))
+
(tramp-with-progress-reporter
(tramp-dissect-file-name (if (file-remote-p filename) filename newname))
0 (format "Renaming %s to %s" filename newname)
- (let ((tmpfile (file-local-copy filename)))
-
- (if tmpfile
- ;; Remote filename.
- (condition-case err
- (rename-file tmpfile newname ok-if-already-exists)
- ((error quit)
- (delete-file tmpfile)
- (signal (car err) (cdr err))))
-
- ;; Remote newname.
- (when (file-directory-p newname)
- (setq newname (expand-file-name
- (file-name-nondirectory filename) newname)))
-
- (with-parsed-tramp-file-name newname nil
- (when (and (not ok-if-already-exists)
- (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-file-property v localname)
- (unless (tramp-smb-send-command
- v (format "put %s \"%s\""
- filename (tramp-smb-get-localname v)))
- (tramp-error v 'file-error "Cannot rename `%s'" filename)))))
-
- (delete-file filename)))
+ (if (and (tramp-equal-remote filename newname)
+ (string-equal
+ (tramp-smb-get-share (tramp-dissect-file-name filename))
+ (tramp-smb-get-share (tramp-dissect-file-name newname))))
+ ;; We can rename directly.
+ (with-parsed-tramp-file-name filename v1
+ (with-parsed-tramp-file-name newname v2
+
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-property v2 (file-name-directory v2-localname))
+ (tramp-flush-file-property v2 v2-localname)
+ (unless (tramp-smb-get-share v2)
+ (tramp-error
+ v2 'file-error "Target `%s' must contain a share name" newname))
+ (unless (tramp-smb-send-command
+ v2 (format "rename \"%s\" \"%s\""
+ (tramp-smb-get-localname v1)
+ (tramp-smb-get-localname v2)))
+ (tramp-error v2 'file-error "Cannot rename `%s'" filename))))
+
+ ;; We must rename via copy.
+ (tramp-compat-copy-file filename newname ok-if-already-exists t t t)
+ (if (file-directory-p filename)
+ (tramp-compat-delete-directory filename 'recursive)
+ (delete-file filename)))))
(defun tramp-smb-handle-set-file-modes (filename mode)
"Like `set-file-modes' for Tramp files."
@@ -896,6 +1162,54 @@
(tramp-error
v 'file-error "Error while changing file's mode %s" filename)))))
+;; We use BUFFER also as connection buffer during setup. Because of
+;; this, its original contents must be saved, and restored once
+;; connection has been setup.
+(defun tramp-smb-handle-start-file-process (name buffer program &rest args)
+ "Like `start-file-process' for Tramp files."
+ (with-parsed-tramp-file-name default-directory nil
+ (let ((command (mapconcat 'identity (cons program args) " "))
+ (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
+ (name1 name)
+ (i 0))
+ (unwind-protect
+ (save-excursion
+ (save-restriction
+ (unless buffer
+ ;; BUFFER can be nil. We use a temporary buffer.
+ (setq buffer (generate-new-buffer tramp-temp-buffer-name)))
+ (while (get-process name1)
+ ;; NAME must be unique as process name.
+ (setq i (1+ i)
+ name1 (format "%s<%d>" name i)))
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name1)
+ (tramp-set-connection-property v "process-buffer" buffer)
+ ;; Activate narrowing in order to save BUFFER contents.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (let ((buffer-undo-list t))
+ (narrow-to-region (point-max) (point-max))
+ (tramp-smb-call-winexe v)
+ (when (tramp-smb-get-share v)
+ (tramp-smb-send-command
+ v (format
+ "cd \"//%s%s\""
+ host (file-name-directory localname))))
+ (tramp-message v 6 "(%s); exit" command)
+ (tramp-send-string v command)))
+ ;; Return value.
+ (tramp-get-connection-process v)))
+
+ ;; Save exit.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (if (string-match tramp-temp-buffer-name (buffer-name))
+ (progn
+ (set-process-buffer (tramp-get-connection-process v) nil)
+ (kill-buffer (current-buffer)))
+ (set-buffer-modified-p bmp)))
+ (tramp-set-connection-property v "process-name" nil)
+ (tramp-set-connection-property v "process-buffer" nil)))))
+
(defun tramp-smb-handle-substitute-in-file-name (filename)
"Like `handle-substitute-in-file-name' for Tramp files.
\"//\" substitutes only in the local filename part. Catches
@@ -999,7 +1313,7 @@
(with-parsed-tramp-file-name (file-name-as-directory directory) nil
(setq localname (or localname "/"))
(with-file-property v localname "file-entries"
- (with-current-buffer (tramp-get-buffer v)
+ (with-current-buffer (tramp-get-connection-buffer v)
(let* ((share (tramp-smb-get-share v))
(cache (tramp-get-connection-property v "share-cache" nil))
res entry)
@@ -1187,7 +1501,7 @@
(tramp-get-connection-process vec) "cifs-capabilities"
(save-match-data
(when (tramp-smb-send-command vec "posix")
- (with-current-buffer (tramp-get-buffer vec)
+ (with-current-buffer (tramp-get-connection-buffer vec)
(goto-char (point-min))
(when
(re-search-forward "Server supports CIFS capabilities" nil t)
@@ -1216,18 +1530,20 @@
(tramp-send-string vec command)
(tramp-smb-wait-for-output vec))
-(defun tramp-smb-maybe-open-connection (vec)
+(defun tramp-smb-maybe-open-connection (vec &optional argument)
"Maybe open a connection to HOST, log in as USER, using `tramp-smb-program'.
Does not do anything if a connection is already open, but re-opens the
-connection if a previous connection has died for some reason."
+connection if a previous connection has died for some reason.
+If ARGUMENT is non-nil, use it as argument for
+`tramp-smb-winexe-program', and suppress any checks."
(let* ((share (tramp-smb-get-share vec))
- (buf (tramp-get-buffer vec))
+ (buf (tramp-get-connection-buffer vec))
(p (get-buffer-process buf)))
;; Check whether we still have the same smbclient version.
;; Otherwise, we must delete the connection cache, because
;; capabilities migh have changed.
- (unless (processp p)
+ (unless (or argument (processp p))
(let ((default-directory (tramp-compat-temporary-file-directory))
(command (concat tramp-smb-program " -V")))
@@ -1271,9 +1587,10 @@
;; Check whether it is still the same share.
(unless
(and p (processp p) (memq (process-status p) '(run open))
- (string-equal
- share
- (tramp-get-connection-property p "smb-share" "")))
+ (or argument
+ (string-equal
+ share
+ (tramp-get-connection-property p "smb-share" ""))))
(save-match-data
;; There might be unread output from checking for share names.
@@ -1288,9 +1605,13 @@
(port (tramp-file-name-port vec))
args)
- (if share
- (setq args (list (concat "//" real-host "/" share)))
- (setq args (list "-g" "-L" real-host )))
+ (cond
+ (argument
+ (setq args (list (concat "//" real-host))))
+ (share
+ (setq args (list (concat "//" real-host "/" share))))
+ (t
+ (setq args (list "-g" "-L" real-host ))))
(if (not (zerop (length real-user)))
(setq args (append args (list "-U" real-user)))
@@ -1300,6 +1621,8 @@
(when port (setq args (append args (list "-p" port))))
(when tramp-smb-conf
(setq args (append args (list "-s" tramp-smb-conf))))
+ (when argument
+ (setq args (append args (list argument))))
;; OK, let's go.
(tramp-with-progress-reporter
@@ -1313,8 +1636,11 @@
(p (let ((default-directory
(tramp-compat-temporary-file-directory)))
(apply #'start-process
- (tramp-buffer-name vec) (tramp-get-buffer vec)
- tramp-smb-program args))))
+ (tramp-get-connection-name vec)
+ (tramp-get-connection-buffer vec)
+ (if argument
+ tramp-smb-winexe-program tramp-smb-program)
+ args))))
(tramp-message
vec 6 "%s" (mapconcat 'identity (process-command p) " "))
@@ -1325,40 +1651,58 @@
tramp-current-user user
tramp-current-host host)
- ;; Play login scenario.
- (tramp-process-actions
- p vec nil
- (if share
- tramp-smb-actions-with-share
- tramp-smb-actions-without-share))
-
- ;; Check server version.
- (with-current-buffer (tramp-get-connection-buffer vec)
- (goto-char (point-min))
- (search-forward-regexp
- "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]" nil t)
- (let ((smbserver-version (match-string 0)))
- (unless
- (string-equal
- smbserver-version
- (tramp-get-connection-property
- vec "smbserver-version" smbserver-version))
- (tramp-flush-directory-property vec "")
- (tramp-flush-connection-property vec))
- (tramp-set-connection-property
- vec "smbserver-version" smbserver-version)))
-
- ;; Set chunksize. Otherwise, `tramp-send-string' might
- ;; try it itself.
- (tramp-set-connection-property p "smb-share" share)
- (tramp-set-connection-property
- p "chunksize" tramp-chunksize))))))))
+ (condition-case err
+ (let (tramp-message-show-message)
+ ;; Play login scenario.
+ (tramp-process-actions
+ p vec nil
+ (if (or argument share)
+ tramp-smb-actions-with-share
+ tramp-smb-actions-without-share))
+
+ ;; Check server version.
+ (unless argument
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (goto-char (point-min))
+ (search-forward-regexp tramp-smb-server-version nil t)
+ (let ((smbserver-version (match-string 0)))
+ (unless
+ (string-equal
+ smbserver-version
+ (tramp-get-connection-property
+ vec "smbserver-version" smbserver-version))
+ (tramp-flush-directory-property vec "")
+ (tramp-flush-connection-property vec))
+ (tramp-set-connection-property
+ vec "smbserver-version" smbserver-version))))
+
+ ;; Set chunksize. Otherwise, `tramp-send-string' might
+ ;; try it itself.
+ (tramp-set-connection-property p "smb-share" share)
+ (tramp-set-connection-property
+ p "chunksize" tramp-chunksize))
+
+ ;; Check for the error reason. If it was due to wrong
+ ;; password, reestablish the connection. We cannot
+ ;; handle this in `tramp-process-actions', because
+ ;; smbclient does not ask for the password, again.
+ (error
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (goto-char (point-min))
+ (if (search-forward-regexp
+ tramp-smb-wrong-passwd-regexp nil t)
+ ;; Disable `auth-source' and `password-cache'.
+ (let (auth-sources)
+ (tramp-cleanup vec)
+ (tramp-smb-maybe-open-connection vec argument))
+ ;; Propagate the error.
+ (signal (car err) (cdr err)))))))))))))
;; We don't use timeouts. If needed, the caller shall wrap around.
(defun tramp-smb-wait-for-output (vec)
"Wait for output from smbclient command.
Returns nil if an error message has appeared."
- (with-current-buffer (tramp-get-buffer vec)
+ (with-current-buffer (tramp-get-connection-buffer vec)
(let ((p (get-buffer-process (current-buffer)))
(found (progn (goto-char (point-min))
(re-search-forward tramp-smb-prompt nil t)))
@@ -1392,10 +1736,68 @@
(goto-char (point-min))
(setq found (re-search-forward tramp-smb-prompt nil t)))
+ (tramp-message vec 6 "\n%s" (buffer-string))
+
+ ;; Remove prompt.
+ (when found
+ (goto-char (point-max))
+ (re-search-backward tramp-smb-prompt nil t)
+ (delete-region (point) (point-max)))
+
;; Return value is whether no error message has appeared.
- (tramp-message vec 6 "\n%s" (buffer-string))
(not err))))
+(defun tramp-smb-kill-winexe-function ()
+ "Send SIGKILL to the winexe process."
+ (ignore-errors
+ (let ((p (get-buffer-process (current-buffer))))
+ (when (and p (processp p) (memq (process-status p) '(run open)))
+ (signal-process (process-id p) 'SIGINT)))))
+
+(defun tramp-smb-call-winexe (vec)
+ "Apply a remote command, if possible, using `tramp-smb-winexe-program'."
+
+ ;; We call `tramp-get-buffer' in order to get a debug buffer for
+ ;; messages.
+ (tramp-get-buffer vec)
+
+ ;; Check for program.
+ (unless (let ((default-directory
+ (tramp-compat-temporary-file-directory)))
+ (executable-find tramp-smb-winexe-program))
+ (tramp-error
+ vec 'file-error "Cannot find program: %s" tramp-smb-winexe-program))
+
+ ;; winexe does not supports ports.
+ (when (tramp-file-name-port vec)
+ (tramp-error vec 'file-error "Port not supported for remote processes"))
+
+ (tramp-smb-maybe-open-connection
+ vec
+ (format
+ "%s %s"
+ tramp-smb-winexe-shell-command tramp-smb-winexe-shell-command-switch))
+
+ (set (make-local-variable 'kill-buffer-hook)
+ '(tramp-smb-kill-winexe-function))
+
+ ;; Suppress "^M". Shouldn't we specify utf8?
+ (set-process-coding-system (tramp-get-connection-process vec) 'raw-text-dos)
+
+ ;; Set width to 128. This avoids mixing prompt and long error messages.
+ (tramp-smb-send-command vec "$rawui = (Get-Host).UI.RawUI")
+ (tramp-smb-send-command vec "$bufsize = $rawui.BufferSize")
+ (tramp-smb-send-command vec "$winsize = $rawui.WindowSize")
+ (tramp-smb-send-command vec "$bufsize.Width = 128")
+ (tramp-smb-send-command vec "$winsize.Width = 128")
+ (tramp-smb-send-command vec "$rawui.BufferSize = $bufsize")
+ (tramp-smb-send-command vec "$rawui.WindowSize = $winsize"))
+
+(defun tramp-smb-shell-quote-argument (s)
+ "Similar to `shell-quote-argument', but uses windows cmd syntax."
+ (let ((system-type 'ms-dos))
+ (shell-quote-argument s)))
+
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-smb 'force)))
@@ -1404,12 +1806,9 @@
;;; TODO:
-;; * Error handling in case password is wrong.
;; * Return more comprehensive file permission string.
;; * Try to remove the inclusion of dummy "" directory. Seems to be at
;; several places, especially in `tramp-smb-handle-insert-directory'.
-;; * (RMS) Use unwind-protect to clean up the state so as to make the state
-;; regular again.
;; * Ignore case in file names.
;;; tramp-smb.el ends here
=== modified file 'lisp/net/tramp.el'
--- a/lisp/net/tramp.el 2012-06-01 13:23:26 +0000
+++ b/lisp/net/tramp.el 2012-06-11 10:30:07 +0000
@@ -57,6 +57,7 @@
;;; Code:
+(eval-when-compile (require 'cl)) ; ignore-errors
(require 'tramp-compat)
;;; User Customizable Internal Variables:
@@ -116,7 +117,7 @@
(eval-and-compile
(when (featurep 'xemacs)
(defcustom tramp-bkup-backup-directory-info nil
- "*Alist of (FILE-REGEXP BACKUP-DIR OPTIONS ...))
+ "Alist of (FILE-REGEXP BACKUP-DIR OPTIONS ...))
It has the same meaning like `bkup-backup-directory-info' from package
`backup-dir'. If a Tramp file is backed up, and BACKUP-DIR is a local
file name, the backup directory is prepended with Tramp file name prefix
@@ -247,15 +248,6 @@
* `tramp-gw-args'
As the attribute name says, additional arguments are specified here
when a method is applied via a gateway.
- * `tramp-password-end-of-line'
- This specifies the string to use for terminating the line after
- submitting the password. If this method parameter is nil, then the
- value of the normal variable `tramp-default-password-end-of-line'
- is used. This parameter is necessary because the \"plink\" program
- requires any two characters after sending the password. These do
- not have to be newline or carriage return characters. Other login
- programs are happy with just one character, the newline character.
- We use \"xy\" as the value for methods using \"plink\".
* `tramp-tmpdir'
A directory on the remote host for temporary files. If not
specified, \"/tmp\" is taken as default.
@@ -408,6 +400,11 @@
(choice :tag "User regexp" regexp sexp)
(choice :tag " Proxy name" string (const nil)))))
+(defcustom tramp-save-ad-hoc-proxies nil
+ "Whether to save ad-hoc proxies persistently."
+ :group 'tramp
+ :type 'boolean)
+
;;;###tramp-autoload
(defconst tramp-local-host-regexp
(concat
@@ -432,7 +429,7 @@
* `tramp-parse-hosts' for \"/etc/hosts\" like files,
* `tramp-parse-passwd' for \"/etc/passwd\" like files.
* `tramp-parse-netrc' for \"~/.netrc\" like files.
- * `tramp-parse-putty' for PuTTY registry keys.
+ * `tramp-parse-putty' for PuTTY registered sessions.
FUNCTION can also be a customer defined function. For more details see
the info pages.")
@@ -471,24 +468,7 @@
(defcustom tramp-rsh-end-of-line "\n"
"String used for end of line in rsh connections.
I don't think this ever needs to be changed, so please tell me about it
-if you need to change this.
-Also see the method parameter `tramp-password-end-of-line' and the normal
-variable `tramp-default-password-end-of-line'."
- :group 'tramp
- :type 'string)
-
-(defcustom tramp-default-password-end-of-line
- tramp-rsh-end-of-line
- "String used for end of line after sending a password.
-This variable provides the default value for the method parameter
-`tramp-password-end-of-line', see `tramp-methods' for more details.
-
-It seems that people using plink under Windows need to send
-\"\\r\\n\" (carriage-return, then newline) after a password, but just
-\"\\n\" after all other lines. This variable can be used for the
-password, see `tramp-rsh-end-of-line' for the other cases.
-
-The default value is to use the same value as `tramp-rsh-end-of-line'."
+if you need to change this."
:group 'tramp
:type 'string)
@@ -505,8 +485,10 @@
;; Allow a prompt to start right after a ^M since it indeed would be
;; displayed at the beginning of the line (and Zsh uses it). This
;; regexp works only for GNU Emacs.
+ ;; Allow also [] style prompts. They can appear only during
+ ;; connection initialization; Tramp redefines the prompt afterwards.
(concat (if (featurep 'xemacs) "" "\\(?:^\\|\r\\)")
- "[^#$%>\n]*#?[#$%>] *\\(\e\\[[0-9;]*[a-zA-Z] *\\)*")
+ "[^]#$%>\n]*#?[]#$%>] *\\(\e\\[[0-9;]*[a-zA-Z] *\\)*")
"Regexp to match prompts from remote shell.
Normally, Tramp expects you to configure `shell-prompt-pattern'
correctly, but sometimes it happens that you are connecting to a
@@ -695,7 +677,7 @@
"Regexp matching delimiter between method and user or host names.
Derived from `tramp-postfix-method-format'.")
-(defconst tramp-user-regexp "[^:/ \t]+"
+(defconst tramp-user-regexp "[^/|: \t]+"
"Regexp matching user names.")
;;;###tramp-autoload
@@ -783,6 +765,14 @@
"\\(" tramp-port-regexp "\\)")
"Regexp matching host names with port numbers.")
+(defconst tramp-postfix-hop-format "|"
+ "String matching delimiter after ad-hoc hop definitions.")
+
+(defconst tramp-postfix-hop-regexp
+ (regexp-quote tramp-postfix-hop-format)
+ "Regexp matching delimiter after ad-hoc hop definitions.
+Derived from `tramp-postfix-hop-format'.")
+
(defconst tramp-postfix-host-format
(cond ((equal tramp-syntax 'ftp) ":")
((equal tramp-syntax 'sep) "]")
@@ -801,22 +791,26 @@
;;; File name format:
+(defconst tramp-remote-file-name-spec-regexp
+ (concat
+ "\\(?:" "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp "\\)?"
+ "\\(?:" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?"
+ "\\(" "\\(?:" tramp-host-regexp "\\|"
+ tramp-prefix-ipv6-regexp tramp-ipv6-regexp
+ tramp-postfix-ipv6-regexp "\\)"
+ "\\(?:" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?")
+"Regular expression matching a Tramp file name between prefix and postfix.")
+
(defconst tramp-file-name-structure
(list
(concat
tramp-prefix-regexp
- "\\(" "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp "\\)?"
- "\\(" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?"
- "\\(" "\\(" tramp-host-regexp
- "\\|"
- tramp-prefix-ipv6-regexp tramp-ipv6-regexp
- tramp-postfix-ipv6-regexp "\\)"
- "\\(" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?"
- tramp-postfix-host-regexp
+ "\\(" "\\(?:" tramp-remote-file-name-spec-regexp
+ tramp-postfix-hop-regexp "\\)+" "\\)?"
+ tramp-remote-file-name-spec-regexp tramp-postfix-host-regexp
"\\(" tramp-localname-regexp "\\)")
- 2 4 5 8)
-
- "List of five elements (REGEXP METHOD USER HOST FILE), detailing \
+ 5 6 7 8 1)
+ "List of six elements (REGEXP METHOD USER HOST FILE HOP), detailing \
the Tramp file name structure.
The first element REGEXP is a regular expression matching a Tramp file
@@ -827,6 +821,9 @@
parentheses matches the method name. The third element USER is
similar, but for the user name. The fourth element HOST is similar,
but for the host name. The fifth element FILE is for the file name.
+The last element HOP is the ad-hoc hop definition, which could be a
+cascade of several hops.
+
These numbers are passed directly to `match-string', which see. That
means the opening parentheses are counted to identify the pair.
@@ -835,8 +832,8 @@
;;;###autoload
(defconst tramp-file-name-regexp-unified
(if (memq system-type '(cygwin windows-nt))
- "\\`/\\([^[/:]\\{2,\\}\\|[^/]\\{2,\\}]\\):"
- "\\`/\\([^[/:]+\\|[^/]+]\\):")
+ "\\`/\\([^[/|:]\\{2,\\}\\|[^/|]\\{2,\\}]\\):"
+ "\\`/\\([^[/|:]+\\|[^/|]+]\\):")
"Value for `tramp-file-name-regexp' for unified remoting.
Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and
Tramp. See `tramp-file-name-structure' for more explanations.
@@ -850,7 +847,7 @@
See `tramp-file-name-structure' for more explanations.")
;;;###autoload
-(defconst tramp-file-name-regexp-url "\\`/[^/:]+://"
+(defconst tramp-file-name-regexp-url "\\`/[^/|:]+://"
"Value for `tramp-file-name-regexp' for URL-like remoting.
See `tramp-file-name-structure' for more explanations.")
@@ -1041,9 +1038,15 @@
;; internal data structure. Convenience functions for internal
;; data structure.
+(defun tramp-get-method-parameter (method param)
+ "Return the method parameter PARAM.
+If the `tramp-methods' entry does not exist, return nil."
+ (let ((entry (assoc param (assoc method tramp-methods))))
+ (when entry (cadr entry))))
+
(defun tramp-file-name-p (vec)
"Check, whether VEC is a Tramp object."
- (and (vectorp vec) (= 4 (length vec))))
+ (and (vectorp vec) (= 5 (length vec))))
(defun tramp-file-name-method (vec)
"Return method component of VEC."
@@ -1061,6 +1064,10 @@
"Return localname component of VEC."
(and (tramp-file-name-p vec) (aref vec 3)))
+(defun tramp-file-name-hop (vec)
+ "Return hop component of VEC."
+ (and (tramp-file-name-p vec) (aref vec 4)))
+
;; The user part of a Tramp file name vector can be of kind
;; "user%domain". Sometimes, we must extract these parts.
(defun tramp-file-name-real-user (vec)
@@ -1157,19 +1164,20 @@
(let ((method (match-string (nth 1 tramp-file-name-structure) name))
(user (match-string (nth 2 tramp-file-name-structure) name))
(host (match-string (nth 3 tramp-file-name-structure) name))
- (localname (match-string (nth 4 tramp-file-name-structure) name)))
+ (localname (match-string (nth 4 tramp-file-name-structure) name))
+ (hop (match-string (nth 5 tramp-file-name-structure) name)))
(when host
(when (string-match tramp-prefix-ipv6-regexp host)
(setq host (replace-match "" nil t host)))
(when (string-match tramp-postfix-ipv6-regexp host)
(setq host (replace-match "" nil t host))))
(if nodefault
- (vector method user host localname)
+ (vector method user host localname hop)
(vector
(tramp-find-method method user host)
(tramp-find-user method user host)
(tramp-find-host method user host)
- localname))))))
+ localname hop))))))
(defun tramp-buffer-name (vec)
"A name for the connection buffer VEC."
@@ -1183,9 +1191,10 @@
(format "*tramp/%s address@hidden" method user host)
(format "*tramp/%s %s*" method host))))
-(defun tramp-make-tramp-file-name (method user host localname)
- "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME."
- (concat tramp-prefix-format
+(defun tramp-make-tramp-file-name (method user host localname &optional hop)
+ "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME.
+When not nil, an optional HOP is prepended."
+ (concat tramp-prefix-format hop
(when (not (zerop (length method)))
(concat method tramp-postfix-method-format))
(when (not (zerop (length user)))
@@ -1357,6 +1366,10 @@
This variable is used to disable messages from `tramp-error'.
The messages are visible anyway, because an error is raised.")
+(defvar tramp-message-show-progress-reporter-message t
+ "Show Tramp progress reporter message in the minibuffer.
+This variable is used to disable recurive progress reporter messages.")
+
(defsubst tramp-message (vec-or-proc level fmt-string &rest args)
"Emit a message depending on verbosity level.
VEC-OR-PROC identifies the Tramp buffer to use. It can be either a
@@ -1422,13 +1435,14 @@
(unwind-protect
(apply 'tramp-error vec-or-proc signal fmt-string args)
(when (and vec-or-proc
+ tramp-message-show-message
(not (zerop tramp-verbose))
(not (tramp-completion-mode-p)))
(let ((enable-recursive-minibuffers t))
(pop-to-buffer
(or (and (bufferp buffer) buffer)
(and (processp vec-or-proc) (process-buffer vec-or-proc))
- (tramp-get-buffer vec-or-proc)))
+ (tramp-get-connection-buffer vec-or-proc)))
(sit-for 30))))))
(defmacro with-parsed-tramp-file-name (filename var &rest body)
@@ -1439,13 +1453,14 @@
the filename structure. It is also used as a prefix for the variables
holding the components. For example, if VAR is the symbol `foo', then
`foo' will be bound to the whole structure, `foo-method' will be bound to
-the method component, and so on for `foo-user', `foo-host', `foo-localname'.
+the method component, and so on for `foo-user', `foo-host', `foo-localname',
+`foo-hop'.
Remaining args are Lisp expressions to be evaluated (inside an implicit
`progn').
If VAR is nil, then we bind `v' to the structure and `method', `user',
-`host', `localname' to the components."
+`host', `localname', `hop' to the components."
`(let* ((,(or var 'v) (tramp-dissect-file-name ,filename))
(,(if var (intern (concat (symbol-name var) "-method")) 'method)
(tramp-file-name-method ,(or var 'v)))
@@ -1454,7 +1469,9 @@
(,(if var (intern (concat (symbol-name var) "-host")) 'host)
(tramp-file-name-host ,(or var 'v)))
(,(if var (intern (concat (symbol-name var) "-localname")) 'localname)
- (tramp-file-name-localname ,(or var 'v))))
+ (tramp-file-name-localname ,(or var 'v)))
+ (,(if var (intern (concat (symbol-name var) "-hop")) 'hop)
+ (tramp-file-name-hop ,(or var 'v))))
,@body))
(put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
@@ -1478,7 +1495,8 @@
(tramp-message ,vec ,level "%s..." ,message)
;; We start a pulsing progress reporter after 3 seconds. Feature
;; introduced in Emacs 24.1.
- (when (and tramp-message-show-message
+ (when (and tramp-message-show-progress-reporter-message
+ tramp-message-show-message
;; Display only when there is a minimum level.
(<= ,level (min tramp-verbose 3)))
(ignore-errors
@@ -1486,11 +1504,10 @@
tm (when pr
(run-at-time 3 0.1 'tramp-progress-reporter-update pr)))))
(unwind-protect
- ;; Execute the body. Unset `tramp-message-show-message' when
- ;; the timer object is created, in order to suppress
- ;; concurrent timers.
- (let ((tramp-message-show-message
- (and tramp-message-show-message (not tm))))
+ ;; Execute the body. Suppress concurrent progress reporter
+ ;; messages.
+ (let ((tramp-message-show-progress-reporter-message
+ (and tramp-message-show-progress-reporter-message (not tm))))
,@body)
;; Stop progress reporter.
(if tm (tramp-compat-funcall 'cancel-timer tm))
@@ -1514,6 +1531,19 @@
'identity))
+(defun tramp-cleanup (vec)
+ "Cleanup connection VEC, but keep the debug buffer."
+ (with-current-buffer (tramp-get-debug-buffer vec)
+ ;; Keep the debug buffer.
+ (rename-buffer
+ (generate-new-buffer-name tramp-temp-buffer-name) 'unique)
+ (tramp-cleanup-connection vec)
+ (if (= (point-min) (point-max))
+ (kill-buffer nil)
+ (rename-buffer (tramp-debug-buffer-name vec) 'unique))
+ ;; We call `tramp-get-buffer' in order to keep the debug buffer.
+ (tramp-get-buffer vec)))
+
;;; Config Manipulation Functions:
;;;###tramp-autoload
@@ -1522,9 +1552,7 @@
FUNCTION-LIST is a list of entries of the form (FUNCTION FILE).
The FUNCTION is intended to parse FILE according its syntax.
It might be a predefined FUNCTION, or a user defined FUNCTION.
-Predefined FUNCTIONs are `tramp-parse-rhosts', `tramp-parse-shosts',
-`tramp-parse-sconfig', `tramp-parse-hosts', `tramp-parse-passwd',
-and `tramp-parse-netrc'.
+For the list of predefined FUNCTIONs see `tramp-completion-function-alist'.
Example:
@@ -1617,7 +1645,9 @@
(ignore-errors
(let ((end (or (tramp-compat-funcall
'overlay-end (symbol-value 'rfn-eshadow-overlay))
- (tramp-compat-funcall 'minibuffer-prompt-end))))
+ (tramp-compat-funcall 'minibuffer-prompt-end)))
+ ;; We do not want to send any remote command.
+ (non-essential t))
(when
(file-remote-p
(tramp-compat-funcall
@@ -1810,7 +1840,7 @@
;; Emacs 23+ only.
'copy-directory
;; Emacs 24+ only.
- 'file-equal-p 'file-in-directory-p
+ 'file-in-directory-p 'file-equal-p
;; XEmacs only.
'dired-make-relative-symlink
'vm-imap-move-mail 'vm-pop-move-mail 'vm-spool-move-mail))
@@ -1886,8 +1916,9 @@
(with-parsed-tramp-file-name filename nil
;; Call the backend function.
(if foreign
- (condition-case err
- (let ((sf (symbol-function foreign)))
+ (tramp-compat-condition-case-unless-debug err
+ (let ((sf (symbol-function foreign))
+ result)
;; Some packages set the default directory to a
;; remote path, before respective Tramp packages
;; are already loaded. This results in
@@ -1897,7 +1928,22 @@
(let ((default-directory
(tramp-compat-temporary-file-directory)))
(load (cadr sf) 'noerror 'nomessage)))
- (apply foreign operation args))
+ ;; If Tramp detects that it shouldn't continue
+ ;; to work, it throws the `suppress' event. We
+ ;; try the default handler then.
+ ;; This could happen for example, when Tramp
+ ;; tries to open the same connection twice in a
+ ;; short time frame.
+ (setq result
+ (catch 'suppress (apply foreign operation args)))
+ (if (eq result 'suppress)
+ (let (tramp-message-show-message)
+ (tramp-message
+ v 1 "Suppress received in operation %s"
+ (append (list operation) args))
+ (tramp-cleanup v)
+ (tramp-run-real-handler operation args))
+ result))
;; Trace that somebody has interrupted the operation.
((debug quit)
@@ -1912,8 +1958,7 @@
;; operations shall return at least a default value
;; in order to give the user a chance to correct the
;; file name in the minibuffer.
- ;; We cannot use `debug' as error handler. In order
- ;; to get a full backtrace, one could apply
+ ;; In order to get a full backtrace, one could apply
;; (setq debug-on-error t debug-on-signal t)
(error
(cond
@@ -2124,18 +2169,27 @@
(defun tramp-completion-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for partial Tramp files."
- (let* ((fullname (tramp-drop-volume-letter
- (expand-file-name filename directory)))
- ;; Possible completion structures.
- (v (tramp-completion-dissect-file-name fullname))
- result result1)
-
- (while v
- (let* ((car (car v))
- (method (tramp-file-name-method car))
- (user (tramp-file-name-user car))
- (host (tramp-file-name-host car))
- (localname (tramp-file-name-localname car))
+ (let ((fullname
+ (tramp-drop-volume-letter (expand-file-name filename directory)))
+ hop result result1)
+
+ ;; Suppress hop from completion.
+ (when (string-match
+ (concat
+ tramp-prefix-regexp
+ "\\(" "\\(" tramp-remote-file-name-spec-regexp
+ tramp-postfix-hop-regexp
+ "\\)+" "\\)")
+ fullname)
+ (setq hop (match-string 1 fullname)
+ fullname (replace-match "" nil nil fullname 1)))
+
+ ;; Possible completion structures.
+ (dolist (elt (tramp-completion-dissect-file-name fullname))
+ (let* ((method (tramp-file-name-method elt))
+ (user (tramp-file-name-user elt))
+ (host (tramp-file-name-host elt))
+ (localname (tramp-file-name-localname elt))
(m (tramp-find-method method user host))
(tramp-current-user user) ; see `tramp-parse-passwd'
all-user-hosts)
@@ -2163,18 +2217,16 @@
;; Possible methods.
(setq result
- (append result (tramp-get-completion-methods m)))))
-
- (setq v (cdr v))))
-
- ;; Unify list, remove nil elements.
- (while result
- (let ((car (car result)))
- (when car
- (add-to-list
- 'result1
- (substring car (length (tramp-drop-volume-letter directory)))))
- (setq result (cdr result))))
+ (append result (tramp-get-completion-methods m)))))))
+
+ ;; Unify list, add hop, remove nil elements.
+ (dolist (elt result)
+ (when elt
+ (string-match tramp-prefix-regexp elt)
+ (setq elt (replace-match (concat tramp-prefix-format hop) nil nil elt))
+ (add-to-list
+ 'result1
+ (substring elt (length (tramp-drop-volume-letter directory))))))
;; Complete local parts.
(append
@@ -2322,9 +2374,9 @@
(concat tramp-prefix-regexp "/$"))
1 nil 3 nil)))
- (mapc (lambda (regexp)
+ (mapc (lambda (structure)
(add-to-list 'result
- (tramp-completion-dissect-file-name1 regexp name)))
+ (tramp-completion-dissect-file-name1 structure name)))
(list
tramp-completion-file-name-structure1
tramp-completion-file-name-structure2
@@ -2358,7 +2410,7 @@
(match-string (nth 3 structure) name)))
(localname (and (nth 4 structure)
(match-string (nth 4 structure) name))))
- (vector method user host localname)))))
+ (vector method user host localname nil)))))
;; This function returns all possible method completions, adding the
;; trailing method delimiter.
@@ -2372,7 +2424,8 @@
(mapcar 'car tramp-methods)))
;; Compares partial user and host names with possible completions.
-(defun tramp-get-completion-user-host (method partial-user partial-host user
host)
+(defun tramp-get-completion-user-host
+ (method partial-user partial-host user host)
"Returns the most expanded string for user and host name completion.
PARTIAL-USER must match USER, PARTIAL-HOST must match HOST."
(cond
@@ -2403,21 +2456,36 @@
(unless (zerop (+ (length user) (length host)))
(tramp-completion-make-tramp-file-name method user host nil)))
+;; Generic function.
+(defun tramp-parse-group (regexp match-level skip-regexp)
+ "Return a (user host) tuple allowed to access.
+User is always nil."
+ (let (result)
+ (when (re-search-forward regexp (point-at-eol) t)
+ (setq result (list nil (match-string match-level))))
+ (or
+ (> (skip-chars-forward skip-regexp) 0)
+ (forward-line 1))
+ result))
+
+;; Generic function.
+(defun tramp-parse-file (filename function)
+ "Return a list of (user host) tuples allowed to access.
+User is always nil."
+ ;; On Windows, there are problems in completion when
+ ;; `default-directory' is remote.
+ (let ((default-directory (tramp-compat-temporary-file-directory)))
+ (when (file-readable-p filename)
+ (with-temp-buffer
+ (insert-file-contents filename)
+ (goto-char (point-min))
+ (loop while (not (eobp)) collect (funcall function))))))
+
;;;###tramp-autoload
(defun tramp-parse-rhosts (filename)
"Return a list of (user host) tuples allowed to access.
Either user or host may be nil."
- ;; On Windows, there are problems in completion when
- ;; `default-directory' is remote.
- (let ((default-directory (tramp-compat-temporary-file-directory))
- res)
- (when (file-readable-p filename)
- (with-temp-buffer
- (insert-file-contents filename)
- (goto-char (point-min))
- (while (not (eobp))
- (push (tramp-parse-rhosts-group) res))))
- res))
+ (tramp-parse-file filename 'tramp-parse-rhosts-group))
(defun tramp-parse-rhosts-group ()
"Return a (user host) tuple allowed to access.
@@ -2427,10 +2495,8 @@
(concat
"^\\(" tramp-host-regexp "\\)"
"\\([ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?")))
- (narrow-to-region (point) (point-at-eol))
- (when (re-search-forward regexp nil t)
+ (when (re-search-forward regexp (point-at-eol) t)
(setq result (append (list (match-string 3) (match-string 1)))))
- (widen)
(forward-line 1)
result))
@@ -2438,124 +2504,63 @@
(defun tramp-parse-shosts (filename)
"Return a list of (user host) tuples allowed to access.
User is always nil."
- ;; On Windows, there are problems in completion when
- ;; `default-directory' is remote.
- (let ((default-directory (tramp-compat-temporary-file-directory))
- res)
- (when (file-readable-p filename)
- (with-temp-buffer
- (insert-file-contents filename)
- (goto-char (point-min))
- (while (not (eobp))
- (push (tramp-parse-shosts-group) res))))
- res))
+ (tramp-parse-file filename 'tramp-parse-shosts-group))
(defun tramp-parse-shosts-group ()
"Return a (user host) tuple allowed to access.
User is always nil."
- (let ((result)
- (regexp (concat "^\\(" tramp-host-regexp "\\)")))
- (narrow-to-region (point) (point-at-eol))
- (when (re-search-forward regexp nil t)
- (setq result (list nil (match-string 1))))
- (widen)
- (or
- (> (skip-chars-forward ",") 0)
- (forward-line 1))
- result))
+ (tramp-parse-group (concat "^\\(" tramp-host-regexp "\\)") 1 ","))
;;;###tramp-autoload
(defun tramp-parse-sconfig (filename)
"Return a list of (user host) tuples allowed to access.
User is always nil."
- ;; On Windows, there are problems in completion when
- ;; `default-directory' is remote.
- (let ((default-directory (tramp-compat-temporary-file-directory))
- res)
- (when (file-readable-p filename)
- (with-temp-buffer
- (insert-file-contents filename)
- (goto-char (point-min))
- (while (not (eobp))
- (push (tramp-parse-sconfig-group) res))))
- res))
+ (tramp-parse-file filename 'tramp-parse-sconfig-group))
(defun tramp-parse-sconfig-group ()
"Return a (user host) tuple allowed to access.
User is always nil."
- (let ((result)
- (regexp (concat "^[ \t]*Host[ \t]+" "\\(" tramp-host-regexp "\\)")))
- (narrow-to-region (point) (point-at-eol))
- (when (re-search-forward regexp nil t)
- (setq result (list nil (match-string 1))))
- (widen)
- (or
- (> (skip-chars-forward ",") 0)
- (forward-line 1))
- result))
+ (tramp-parse-group
+ (concat "^[ \t]*Host[ \t]+" "\\(" tramp-host-regexp "\\)") 1 ","))
+
+;; Generic function.
+(defun tramp-parse-shostkeys-sknownhosts (dirname regexp)
+ "Return a list of (user host) tuples allowed to access.
+User is always nil."
+ ;; On Windows, there are problems in completion when
+ ;; `default-directory' is remote.
+ (let* ((default-directory (tramp-compat-temporary-file-directory))
+ (files (and (file-directory-p dirname) (directory-files dirname))))
+ (loop for f in files
+ when (and (not (string-match "^\\.\\.?$" f)) (string-match regexp f))
+ collect (list nil (match-string 1 f)))))
;;;###tramp-autoload
(defun tramp-parse-shostkeys (dirname)
"Return a list of (user host) tuples allowed to access.
User is always nil."
- ;; On Windows, there are problems in completion when
- ;; `default-directory' is remote.
- (let* ((default-directory (tramp-compat-temporary-file-directory))
- (regexp (concat "^key_[0-9]+_\\(" tramp-host-regexp "\\)\\.pub$"))
- (files (when (file-directory-p dirname) (directory-files dirname)))
- result)
- (while files
- (when (string-match regexp (car files))
- (push (list nil (match-string 1 (car files))) result))
- (setq files (cdr files)))
- result))
+ (tramp-parse-shostkeys-sknownhosts
+ dirname (concat "^key_[0-9]+_\\(" tramp-host-regexp "\\)\\.pub$")))
+;;;###tramp-autoload
(defun tramp-parse-sknownhosts (dirname)
"Return a list of (user host) tuples allowed to access.
User is always nil."
- ;; On Windows, there are problems in completion when
- ;; `default-directory' is remote.
- (let* ((default-directory (tramp-compat-temporary-file-directory))
- (regexp (concat "^\\(" tramp-host-regexp
- "\\)\\.ssh-\\(dss\\|rsa\\)\\.pub$"))
- (files (when (file-directory-p dirname) (directory-files dirname)))
- result)
- (while files
- (when (string-match regexp (car files))
- (push (list nil (match-string 1 (car files))) result))
- (setq files (cdr files)))
- result))
+ (tramp-parse-shostkeys-sknownhosts
+ dirname
+ (concat "^\\(" tramp-host-regexp "\\)\\.ssh-\\(dss\\|rsa\\)\\.pub$")))
;;;###tramp-autoload
(defun tramp-parse-hosts (filename)
"Return a list of (user host) tuples allowed to access.
User is always nil."
- ;; On Windows, there are problems in completion when
- ;; `default-directory' is remote.
- (let ((default-directory (tramp-compat-temporary-file-directory))
- res)
- (when (file-readable-p filename)
- (with-temp-buffer
- (insert-file-contents filename)
- (goto-char (point-min))
- (while (not (eobp))
- (push (tramp-parse-hosts-group) res))))
- res))
+ (tramp-parse-file filename 'tramp-parse-hosts-group))
(defun tramp-parse-hosts-group ()
"Return a (user host) tuple allowed to access.
User is always nil."
- (let ((result)
- (regexp
- (concat "^\\(" tramp-ipv6-regexp "\\|" tramp-host-regexp "\\)")))
- (narrow-to-region (point) (point-at-eol))
- (when (re-search-forward regexp nil t)
- (setq result (list nil (match-string 1))))
- (widen)
- (or
- (> (skip-chars-forward " \t") 0)
- (forward-line 1))
- result))
+ (tramp-parse-group
+ (concat "^\\(" tramp-ipv6-regexp "\\|" tramp-host-regexp "\\)") 1 " \t"))
;; For su-alike methods it would be desirable to return "address@hidden"
;; as default. Unfortunately, we have no information whether any user name
@@ -2565,29 +2570,17 @@
(defun tramp-parse-passwd (filename)
"Return a list of (user host) tuples allowed to access.
Host is always \"localhost\"."
- ;; On Windows, there are problems in completion when
- ;; `default-directory' is remote.
- (let ((default-directory (tramp-compat-temporary-file-directory))
- res)
- (if (zerop (length tramp-current-user))
- '(("root" nil))
- (when (file-readable-p filename)
- (with-temp-buffer
- (insert-file-contents filename)
- (goto-char (point-min))
- (while (not (eobp))
- (push (tramp-parse-passwd-group) res))))
- res)))
+ (if (zerop (length tramp-current-user))
+ '(("root" nil))
+ (tramp-parse-file filename 'tramp-parse-passwd-group)))
(defun tramp-parse-passwd-group ()
"Return a (user host) tuple allowed to access.
Host is always \"localhost\"."
(let ((result)
(regexp (concat "^\\(" tramp-user-regexp "\\):")))
- (narrow-to-region (point) (point-at-eol))
- (when (re-search-forward regexp nil t)
+ (when (re-search-forward regexp (point-at-eol) t)
(setq result (list (match-string 1) "localhost")))
- (widen)
(forward-line 1)
result))
@@ -2595,17 +2588,7 @@
(defun tramp-parse-netrc (filename)
"Return a list of (user host) tuples allowed to access.
User may be nil."
- ;; On Windows, there are problems in completion when
- ;; `default-directory' is remote.
- (let ((default-directory (tramp-compat-temporary-file-directory))
- res)
- (when (file-readable-p filename)
- (with-temp-buffer
- (insert-file-contents filename)
- (goto-char (point-min))
- (while (not (eobp))
- (push (tramp-parse-netrc-group) res))))
- res))
+ (tramp-parse-file filename 'tramp-parse-netrc-group))
(defun tramp-parse-netrc-group ()
"Return a (user host) tuple allowed to access.
@@ -2615,37 +2598,33 @@
(concat
"^[ \t]*machine[ \t]+" "\\(" tramp-host-regexp "\\)"
"\\([ \t]+login[ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?")))
- (narrow-to-region (point) (point-at-eol))
- (when (re-search-forward regexp nil t)
+ (when (re-search-forward regexp (point-at-eol) t)
(setq result (list (match-string 3) (match-string 1))))
- (widen)
(forward-line 1)
result))
;;;###tramp-autoload
-(defun tramp-parse-putty (registry)
+(defun tramp-parse-putty (registry-or-dirname)
"Return a list of (user host) tuples allowed to access.
User is always nil."
- ;; On Windows, there are problems in completion when
- ;; `default-directory' is remote.
- (let ((default-directory (tramp-compat-temporary-file-directory))
- res)
- (with-temp-buffer
- (when (zerop (tramp-compat-call-process "reg" nil t nil "query"
registry))
- (goto-char (point-min))
- (while (not (eobp))
- (push (tramp-parse-putty-group registry) res))))
- res))
+ (if (memq system-type '(windows-nt))
+ (with-temp-buffer
+ (when (zerop (tramp-compat-call-process
+ "reg" nil t nil "query" registry-or-dirname))
+ (goto-char (point-min))
+ (loop while (not (eobp)) collect
+ (tramp-parse-putty-group registry-or-dirname))))
+ ;; UNIX case.
+ (tramp-parse-shostkeys-sknownhosts
+ registry-or-dirname (concat "^\\(" tramp-host-regexp "\\)$"))))
(defun tramp-parse-putty-group (registry)
"Return a (user host) tuple allowed to access.
User is always nil."
(let ((result)
(regexp (concat (regexp-quote registry) "\\\\\\(.+\\)")))
- (narrow-to-region (point) (point-at-eol))
- (when (re-search-forward regexp nil t)
+ (when (re-search-forward regexp (point-at-eol) t)
(setq result (list nil (match-string 1))))
- (widen)
(forward-line 1)
result))
@@ -2855,78 +2834,80 @@
(setq filename (expand-file-name filename))
(let (result local-copy remote-copy)
(with-parsed-tramp-file-name filename nil
- (unwind-protect
- (if (not (file-exists-p filename))
- ;; We don't raise a Tramp error, because it might be
- ;; suppressed, like in `find-file-noselect-1'.
- (signal 'file-error
- (list "File not found on remote host" filename))
-
- (if (and (tramp-local-host-p v)
- (let (file-name-handler-alist)
- (file-readable-p localname)))
- ;; Short track: if we are on the local host, we can
- ;; run directly.
- (setq result
- (tramp-run-real-handler
- 'insert-file-contents
- (list localname visit beg end replace)))
-
- ;; When we shall insert only a part of the file, we copy
- ;; this part.
- (when (or beg end)
- (setq remote-copy (tramp-make-tramp-temp-file v))
- ;; This is defined in tramp-sh.el. Let's assume this
- ;; is loaded already.
- (tramp-compat-funcall 'tramp-send-command
- v
- (cond
- ((and beg end)
- (format "dd bs=1 skip=%d if=%s count=%d of=%s"
- beg (tramp-shell-quote-argument localname)
- (- end beg) remote-copy))
- (beg
- (format "dd bs=1 skip=%d if=%s of=%s"
- beg (tramp-shell-quote-argument localname)
- remote-copy))
- (end
- (format "dd bs=1 count=%d if=%s of=%s"
- end (tramp-shell-quote-argument localname)
- remote-copy)))))
-
- ;; `insert-file-contents-literally' takes care to avoid
- ;; calling jka-compr. By let-binding
- ;; `inhibit-file-name-operation', we propagate that care
- ;; to the `file-local-copy' operation.
- (setq local-copy
- (let ((inhibit-file-name-operation
- (when (eq inhibit-file-name-operation
- 'insert-file-contents)
- 'file-local-copy)))
- (cond
- ((stringp remote-copy)
- (file-local-copy
- (tramp-make-tramp-file-name
- method user host remote-copy)))
- ((stringp tramp-temp-buffer-file-name)
- (copy-file filename tramp-temp-buffer-file-name 'ok)
- tramp-temp-buffer-file-name)
- (t (file-local-copy filename)))))
-
- ;; When the file is not readable for the owner, it
- ;; cannot be inserted, even if it is readable for the
- ;; group or for everybody.
- (set-file-modes local-copy (tramp-compat-octal-to-decimal "0600"))
-
- (when (and (null remote-copy)
- (tramp-get-method-parameter
- method 'tramp-copy-keep-tmpfile))
- ;; We keep the local file for performance reasons,
- ;; useful for "rsync".
- (setq tramp-temp-buffer-file-name local-copy))
-
- (tramp-with-progress-reporter
- v 3 (format "Inserting local temp file `%s'" local-copy)
+ (tramp-with-progress-reporter
+ v 3 (format "Inserting `%s'" filename)
+ (unwind-protect
+ (if (not (file-exists-p filename))
+ ;; We don't raise a Tramp error, because it might be
+ ;; suppressed, like in `find-file-noselect-1'.
+ (signal 'file-error
+ (list "File not found on remote host" filename))
+
+ (if (and (tramp-local-host-p v)
+ (let (file-name-handler-alist)
+ (file-readable-p localname)))
+ ;; Short track: if we are on the local host, we can
+ ;; run directly.
+ (setq result
+ (tramp-run-real-handler
+ 'insert-file-contents
+ (list localname visit beg end replace)))
+
+ ;; When we shall insert only a part of the file, we
+ ;; copy this part.
+ (when (or beg end)
+ (setq remote-copy (tramp-make-tramp-temp-file v))
+ ;; This is defined in tramp-sh.el. Let's assume
+ ;; this is loaded already.
+ (tramp-compat-funcall
+ 'tramp-send-command
+ v
+ (cond
+ ((and beg end)
+ (format "dd bs=1 skip=%d if=%s count=%d of=%s"
+ beg (tramp-shell-quote-argument localname)
+ (- end beg) remote-copy))
+ (beg
+ (format "dd bs=1 skip=%d if=%s of=%s"
+ beg (tramp-shell-quote-argument localname)
+ remote-copy))
+ (end
+ (format "dd bs=1 count=%d if=%s of=%s"
+ end (tramp-shell-quote-argument localname)
+ remote-copy)))))
+
+ ;; `insert-file-contents-literally' takes care to
+ ;; avoid calling jka-compr. By let-binding
+ ;; `inhibit-file-name-operation', we propagate that
+ ;; care to the `file-local-copy' operation.
+ (setq local-copy
+ (let ((inhibit-file-name-operation
+ (when (eq inhibit-file-name-operation
+ 'insert-file-contents)
+ 'file-local-copy)))
+ (cond
+ ((stringp remote-copy)
+ (file-local-copy
+ (tramp-make-tramp-file-name
+ method user host remote-copy)))
+ ((stringp tramp-temp-buffer-file-name)
+ (copy-file filename tramp-temp-buffer-file-name 'ok)
+ tramp-temp-buffer-file-name)
+ (t (file-local-copy filename)))))
+
+ ;; When the file is not readable for the owner, it
+ ;; cannot be inserted, even if it is readable for the
+ ;; group or for everybody.
+ (set-file-modes
+ local-copy (tramp-compat-octal-to-decimal "0600"))
+
+ (when (and (null remote-copy)
+ (tramp-get-method-parameter
+ method 'tramp-copy-keep-tmpfile))
+ ;; We keep the local file for performance reasons,
+ ;; useful for "rsync".
+ (setq tramp-temp-buffer-file-name local-copy))
+
;; We must ensure that `file-coding-system-alist'
;; matches `local-copy'.
(let ((file-coding-system-alist
@@ -2934,21 +2915,21 @@
filename local-copy)))
(setq result
(insert-file-contents
- local-copy nil nil nil replace))))))
+ local-copy nil nil nil replace)))))
- ;; Save exit.
- (progn
- (when visit
- (setq buffer-file-name filename)
- (setq buffer-read-only (not (file-writable-p filename)))
- (set-visited-file-modtime)
- (set-buffer-modified-p nil))
- (when (and (stringp local-copy)
- (or remote-copy (null tramp-temp-buffer-file-name)))
- (delete-file local-copy))
- (when (stringp remote-copy)
- (delete-file
- (tramp-make-tramp-file-name method user host remote-copy))))))
+ ;; Save exit.
+ (progn
+ (when visit
+ (setq buffer-file-name filename)
+ (setq buffer-read-only (not (file-writable-p filename)))
+ (set-visited-file-modtime)
+ (set-buffer-modified-p nil))
+ (when (and (stringp local-copy)
+ (or remote-copy (null tramp-temp-buffer-file-name)))
+ (delete-file local-copy))
+ (when (stringp remote-copy)
+ (delete-file
+ (tramp-make-tramp-file-name method user host remote-copy)))))))
;; Result.
(list (expand-file-name filename)
@@ -3136,7 +3117,10 @@
(let ((enable-recursive-minibuffers t))
(tramp-check-for-regexp proc tramp-password-prompt-regexp)
(tramp-message vec 3 "Sending %s" (match-string 1))
- (tramp-enter-password proc)
+ ;; We don't call `tramp-send-string' in order to hide the
+ ;; password from the debug buffer.
+ (process-send-string
+ proc (concat (tramp-read-passwd proc) tramp-local-end-of-line))
;; Hide password prompt.
(narrow-to-region (point-max) (point-max)))))
@@ -3240,7 +3224,7 @@
connection buffer."
;; Preserve message for `progress-reporter'.
(tramp-compat-with-temp-message ""
- ;; Enable auth-source and password-cache. We must use
+ ;; Enable `auth-source' and `password-cache'. We must use
;; tramp-current-* variables in case we have several hops.
(tramp-set-connection-property
(tramp-dissect-file-name
@@ -3315,14 +3299,12 @@
'buffer-substring-no-properties
1 (min (1+ tramp-echo-mark-marker-length) (point-max))))))
;; No echo to be handled, now we can look for the regexp.
- ;; Sometimes, the buffer is much to huge, and we run into a
- ;; "Stack overflow in regexp matcher". For example, directory
- ;; listings with some thousand files. Therefore, we look from
- ;; the end for the last line. We ignore also superlong lines,
- ;; like created with "//DIRED//".
+ ;; Sometimes, lines are much to long, and we run into a "Stack
+ ;; overflow in regexp matcher". For example, //DIRED// lines of
+ ;; directory listings with some thousand files. Therefore, we
+ ;; look from the end.
(goto-char (point-max))
- (unless (> (- (point) (point-at-bol)) 128)
- (re-search-backward regexp (point-at-bol) t)))))
+ (ignore-errors (re-search-backward regexp nil t)))))
(defun tramp-wait-for-regexp (proc timeout regexp)
"Wait for a REGEXP to appear from process PROC within TIMEOUT seconds.
@@ -3362,18 +3344,6 @@
(tramp-error proc 'file-error "[[Regexp `%s' not found]]" regexp)))
found)))
-;; We don't call `tramp-send-string' in order to hide the password
-;; from the debug buffer, and because end-of-line handling of the
-;; string.
-(defun tramp-enter-password (proc)
- "Prompt for a password and send it to the remote end."
- (process-send-string
- proc (concat (tramp-read-passwd proc)
- (or (tramp-get-method-parameter
- tramp-current-method
- 'tramp-password-end-of-line)
- tramp-default-password-end-of-line))))
-
;; It seems that Tru64 Unix does not like it if long strings are sent
;; to it in one go. (This happens when sending the Perl
;; `file-attributes' implementation, for instance.) Therefore, we
@@ -3446,12 +3416,7 @@
(stringp (file-remote-p file2))
(string-equal (file-remote-p file1) (file-remote-p file2))))
-(defun tramp-get-method-parameter (method param)
- "Return the method parameter PARAM.
-If the `tramp-methods' entry does not exist, return nil."
- (let ((entry (assoc param (assoc method tramp-methods))))
- (when entry (cadr entry))))
-
+;;;###tramp-autoload
(defun tramp-mode-string-to-int (mode-string)
"Converts a ten-letter `drwxrwxrwx'-style mode string into mode bits."
(let* (case-fold-search
@@ -3523,6 +3488,7 @@
(t (error "Tenth char `%c' must be one of `xtT-'"
other-execute-or-sticky)))))))
+;;;###tramp-autoload
(defun tramp-local-host-p (vec)
"Return t if this points to the local host, nil otherwise."
;; We cannot use `tramp-file-name-real-host'. A port is an
@@ -3564,6 +3530,7 @@
dir
(tramp-error vec 'file-error "Directory %s not accessible" dir)))))
+;;;###tramp-autoload
(defun tramp-make-tramp-temp-file (vec)
"Create a temporary file on the remote host identified by VEC.
Return the local name of the temporary file."
@@ -3658,6 +3625,7 @@
;;; Compatibility functions section:
+;;;###tramp-autoload
(defun tramp-read-passwd (proc &optional prompt)
"Read a password from user (compat function).
Consults the auth-source package.
@@ -3708,6 +3676,7 @@
(read-passwd pw-prompt))
(tramp-set-connection-property v "first-password-request" nil)))))
+;;;###tramp-autoload
(defun tramp-clear-passwd (vec)
"Clear password cache for connection related to VEC."
(tramp-compat-funcall
@@ -3730,6 +3699,7 @@
("oct" . 10) ("nov" . 11) ("dec" . 12))
"Alist mapping month names to integers.")
+;;;###tramp-autoload
(defun tramp-time-less-p (t1 t2)
"Say whether time value T1 is less than time value T2."
(unless t1 (setq t1 '(0 0)))
@@ -3747,6 +3717,7 @@
(list (- (car t1) (car t2) (if borrow 1 0))
(- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
+;;;###tramp-autoload
(defun tramp-time-diff (t1 t2)
"Return the difference between the two times, in seconds.
T1 and T2 are time values (as returned by `current-time' for example)."
@@ -3841,8 +3812,6 @@
;; again. (Greg Stark)
;; * Username and hostname completion.
;; ** Try to avoid usage of `last-input-event' in `tramp-completion-mode-p'.
-;; ** Unify `tramp-parse-{rhosts,shosts,sconfig,hosts,passwd,netrc}'.
-;; Code is nearly identical.
;; * Make `tramp-default-user' obsolete.
;; * Implement a general server-local-variable mechanism, as there are
;; probably other variables that need different values for different
=== modified file 'lisp/net/trampver.el'
--- a/lisp/net/trampver.el 2012-01-19 07:21:25 +0000
+++ b/lisp/net/trampver.el 2012-06-11 10:30:07 +0000
@@ -31,7 +31,7 @@
;; should be changed only there.
;;;###tramp-autoload
-(defconst tramp-version "2.2.3-24.1"
+(defconst tramp-version "2.2.6-pre"
"This version of Tramp.")
;;;###tramp-autoload
@@ -44,7 +44,7 @@
(= emacs-major-version 21)
(>= emacs-minor-version 4)))
"ok"
- (format "Tramp 2.2.3-24.1 is not fit for %s"
+ (format "Tramp 2.2.6-pre is not fit for %s"
(when (string-match "^.*$" (emacs-version))
(match-string 0 (emacs-version)))))))
(unless (string-match "\\`ok\\'" x) (error "%s" x)))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r108555: Sync with Tramp 2.2.6-pre.,
Michael Albinus <=