;;; tramp.el --- Transparent Remote Access, Multiple Protocol
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; (copyright statements below in code to be updated with the above notice)
;;
;; This package only works for Emacs 21.1 and higher, and for XEmacs 21.4
;; and higher. For XEmacs 21, you need the package `fsf-compat' for
-;; the `with-timeout' macro.)
+;; the `with-timeout' macro.
;;
;; Also see the todo list at the bottom of this file.
;;
;; The Tramp version number and bug report address, as prepared by configure.
(require 'trampver)
(add-hook 'tramp-unload-hook
- '(lambda ()
- (when (featurep 'trampver)
- (unload-feature 'trampver 'force))))
+ (lambda ()
+ (when (featurep 'trampver)
+ (unload-feature 'trampver 'force))))
(require 'tramp-compat)
(add-hook 'tramp-unload-hook
- '(lambda ()
- (when (featurep 'tramp-compat)
- (unload-feature 'tramp-compat 'force))))
+ (lambda ()
+ (when (featurep 'tramp-compat)
+ (unload-feature 'tramp-compat 'force))))
(require 'format-spec) ; from Gnus 5.8, also in tar ball
;; As long as password.el is not part of (X)Emacs, it shouldn't
(autoload 'tramp-flush-connection-property "tramp-cache")
(autoload 'tramp-parse-connection-properties "tramp-cache")
(add-hook 'tramp-unload-hook
- '(lambda ()
- (when (featurep 'tramp-cache)
- (unload-feature 'tramp-cache 'force))))
+ (lambda ()
+ (when (featurep 'tramp-cache)
+ (unload-feature 'tramp-cache 'force))))
(autoload 'tramp-uuencode-region "tramp-uu"
"Implementation of `uuencode' in Lisp.")
(add-hook 'tramp-unload-hook
- '(lambda ()
- (when (featurep 'tramp-uu)
- (unload-feature 'tramp-uu 'force))))
+ (lambda ()
+ (when (featurep 'tramp-uu)
+ (unload-feature 'tramp-uu 'force))))
(autoload 'uudecode-decode-region "uudecode")
'tramp-fish
;; tramp-gvfs needs D-Bus messages. Available since Emacs 23
- ;; on some system types.
+ ;; on some system types. We don't call `dbus-ping', because
+ ;; this would load dbus.el.
(when (and (featurep 'dbusbind)
+ (condition-case nil
+ (funcall 'dbus-get-unique-name :session)
+ (error nil))
(tramp-compat-process-running-p "gvfs-fuse-daemon"))
'tramp-gvfs)
;; Load gateways. It needs `make-network-process' from Emacs 22.
- (when (functionp 'make-network-process) 'tramp-gw)))
+ (when (functionp 'make-network-process) 'tramp-gw)
+
+ ;; tramp-imap needs both epa (from Emacs 23.1) and imap-hash
+ ;; (from Emacs 23.2).
+ (when (and (locate-library "epa") (locate-library "imap-hash"))
+ 'tramp-imap)))
(when feature
;; We have used just some basic tests, whether a package shall
:type 'boolean)
(defcustom tramp-verbose 3
- "*Verbosity level for Tramp.
+ "*Verbosity level for Tramp messages.
Any level x includes messages for all levels 1 .. x-1. The levels are
0 silent (no tramp messages at all)
:group 'tramp
:type 'integer)
-;; Emacs case
+;; Emacs case.
(eval-and-compile
(when (boundp 'backup-directory-alist)
(defcustom tramp-backup-directory-alist nil
:group 'tramp
:type 'string)
+;; ksh on OpenBSD 4.5 requires, that PS1 contains a `#' character for
+;; root users. It uses the `$' character for other users. In order
+;; to guarantee a proper prompt, we use "#$" for the prompt.
+
+(defvar tramp-end-of-output
+ (format
+ "///%s#$"
+ (md5 (concat (prin1-to-string process-environment) (current-time-string))))
+ "String used to recognize end of output.
+The '$' character at the end is quoted; the string cannot be
+detected as prompt when being sent on echoing hosts, therefore.")
+
+(defconst tramp-initial-end-of-output "#$ "
+ "Prompt when establishing a connection.")
+
(defvar tramp-methods
`(("rcp" (tramp-login-program "rsh")
(tramp-login-args (("%h") ("-l" "%u")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program "rcp")
- (tramp-copy-args (("-p" "%k")))
+ (tramp-copy-args (("-p" "%k") ("-r")))
(tramp-copy-keep-date t)
+ (tramp-copy-recursive t)
(tramp-password-end-of-line nil))
("scp" (tramp-login-program "ssh")
(tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") ("-q")
("-e" "none")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program "scp")
- (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q")))
+ (tramp-copy-args (("-P" "%p") ("-p" "%k")
+ ("-q") ("-r")))
(tramp-copy-keep-date t)
+ (tramp-copy-recursive t)
(tramp-password-end-of-line nil)
(tramp-gw-args (("-o"
"GlobalKnownHostsFile=/dev/null")
(tramp-remote-sh "/bin/sh")
(tramp-copy-program "scp")
(tramp-copy-args (("-1") ("-P" "%p") ("-p" "%k")
- ("-q")))
+ ("-q") ("-r")))
(tramp-copy-keep-date t)
+ (tramp-copy-recursive t)
(tramp-password-end-of-line nil)
(tramp-gw-args (("-o"
"GlobalKnownHostsFile=/dev/null")
(tramp-remote-sh "/bin/sh")
(tramp-copy-program "scp")
(tramp-copy-args (("-2") ("-P" "%p") ("-p" "%k")
- ("-q")))
+ ("-q") ("-r")))
(tramp-copy-keep-date t)
+ (tramp-copy-recursive t)
(tramp-password-end-of-line nil)
(tramp-gw-args (("-o"
"GlobalKnownHostsFile=/dev/null")
("-e" "none")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program "scp1")
- (tramp-copy-args (("-p" "%k")))
+ (tramp-copy-args (("-p" "%k") ("-r")))
(tramp-copy-keep-date t)
+ (tramp-copy-recursive t)
(tramp-password-end-of-line nil))
("scp2_old"
(tramp-login-program "ssh2")
("-e" "none")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program "scp2")
- (tramp-copy-args (("-p" "%k")))
+ (tramp-copy-args (("-p" "%k") ("-r")))
(tramp-copy-keep-date t)
+ (tramp-copy-recursive t)
(tramp-password-end-of-line nil))
("sftp" (tramp-login-program "ssh")
(tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
("-e" "none")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program "rsync")
- (tramp-copy-args (("-e" "ssh") ("-t" "%k")))
+ (tramp-copy-args (("-e" "ssh") ("-t" "%k") ("-r")))
(tramp-copy-keep-date t)
+ (tramp-copy-keep-tmpfile t)
+ (tramp-copy-recursive t)
+ (tramp-password-end-of-line nil))
+ ("rsyncc"
+ (tramp-login-program "ssh")
+ (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
+ ("-o" "ControlPath=%t.%%r@%%h:%%p")
+ ("-o" "ControlMaster=yes")
+ ("-e" "none")))
+ (tramp-remote-sh "/bin/sh")
+ (tramp-copy-program "rsync")
+ (tramp-copy-args (("-t" "%k") ("-r")))
+ (tramp-copy-env (("RSYNC_RSH")
+ (,(concat
+ "ssh"
+ " -o ControlPath=%t.%%r@%%h:%%p"
+ " -o ControlMaster=auto"))))
+ (tramp-copy-keep-date t)
+ (tramp-copy-keep-tmpfile t)
+ (tramp-copy-recursive t)
(tramp-password-end-of-line nil))
("remcp" (tramp-login-program "remsh")
(tramp-login-args (("%h") ("-l" "%u")))
;; `tramp-compute-multi-hops'.
(tramp-login-args (("-load") ("%h") ("-t")
(,(format
- "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=$ '"
- tramp-terminal-type))
+ "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=%s'"
+ tramp-terminal-type
+ tramp-initial-end-of-output))
("/bin/sh")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program nil)
* `tramp-copy-keep-date'
This specifies whether the copying program when the preserves the
timestamp of the original file.
+ * `tramp-copy-keep-tmpfile'
+ This specifies whether a temporary local file shall be kept
+ for optimization reasons (useful for \"rsync\" methods).
+ * `tramp-copy-recursive'
+ Whether the operation copies directories recursively.
* `tramp-default-port'
The default port of a method is needed in case of gateway connections.
Additionally, it is used as indication which method is prepared for
;; more performant for large files, and it hasn't too serious delays
;; for small files. But it must be ensured that there aren't
;; permanent password queries. Either a password agent like
- ;; "ssh-agent" or "Pageant" shall run, or the optional password.el
- ;; package shall be active for password caching. "scpc" would be
- ;; another good choice because of the "ControlMaster" option, but
- ;; this is a more modern alternative in OpenSSH 4, which cannot be
- ;; taken as default.
+ ;; "ssh-agent" or "Pageant" shall run, or the optional
+ ;; password-cache.el or auth-sources.el packages shall be active for
+ ;; password caching. "scpc" would be another good choice because of
+ ;; the "ControlMaster" option, but this is a more modern alternative
+ ;; in OpenSSH 4, which cannot be taken as default.
(cond
;; PuTTY is installed.
((executable-find "pscp")
(if (or (fboundp 'password-read)
+ (fboundp 'auth-source-user-or-password)
;; Pageant is running.
(tramp-compat-process-running-p "Pageant"))
"pscp"
;; There is an ssh installation.
((executable-find "scp")
(if (or (fboundp 'password-read)
+ (fboundp 'auth-source-user-or-password)
;; ssh-agent is running.
(getenv "SSH_AUTH_SOCK")
(getenv "SSH_AGENT_PID"))
"scp2_old" tramp-completion-function-alist-ssh)
(tramp-set-completion-function
"rsync" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function
+ "rsyncc" tramp-completion-function-alist-ssh)
(tramp-set-completion-function
"remcp" tramp-completion-function-alist-rsh)
(tramp-set-completion-function
(defconst tramp-echo-mark-marker "_echo"
"String marker to surround echoed commands.")
-(defconst tramp-echo-mark "_echo\b\b\b\b\b"
+(defconst tramp-echo-mark-marker-length (length tramp-echo-mark-marker)
+ "String length of `tramp-echo-mark-marker'.")
+
+(defconst tramp-echo-mark
+ (concat tramp-echo-mark-marker
+ (make-string tramp-echo-mark-marker-length ?\b))
"String mark to be transmitted around shell commands.
Used to separate their echo from the output they produce. This
will only be used if we cannot disable remote echo via stty.
followed by an equal number of backspaces to erase them will
usually suffice.")
-(defconst tramp-echoed-echo-mark-regexp "_echo\\(\b\\( \b\\)?\\)\\{5\\}"
+(defconst tramp-echoed-echo-mark-regexp
+ (format "%s\\(\b\\( \b\\)?\\)\\{%d\\}"
+ tramp-echo-mark-marker tramp-echo-mark-marker-length)
"Regexp which matches `tramp-echo-mark' as it gets echoed by
the remote shell.")
:type 'regexp)
(defcustom tramp-shell-prompt-pattern
- "^[^#$%>\n]*[#$%>] *\\(\e\\[[0-9;]*[a-zA-Z] *\\)*"
+ ;; 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).
+ "\\(?:^\\|\r\\)[^#$%>\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
Tramp recognizes things matched by `shell-prompt-pattern' as prompt,
and also things matched by this variable. The default value of this
variable is similar to the default value of `shell-prompt-pattern',
-which should work well in many cases."
+which should work well in many cases.
+
+This regexp must match both `tramp-initial-end-of-output' and
+`tramp-end-of-output'."
:group 'tramp
:type 'regexp)
"Buffer name for a temporary buffer.
It shall be used in combination with `generate-new-buffer-name'.")
+(defvar tramp-temp-buffer-file-name nil
+ "File name of a persistent local temporary file.
+Useful for \"rsync\" like methods.")
+(make-variable-buffer-local 'tramp-temp-buffer-file-name)
+
(defcustom tramp-sh-extra-args '(("/bash\\'" . "-norc -noprofile"))
"*Alist specifying extra arguments to pass to the remote shell.
Entries are (REGEXP . ARGS) where REGEXP is a regular expression
;;;###autoload
(defconst tramp-root-regexp
(if (memq system-type '(cygwin windows-nt))
- "^\\([a-zA-Z]:\\)?/"
- "^/")
+ "\\`\\([a-zA-Z]:\\)?/"
+ "\\`/")
"Beginning of an incomplete Tramp file name.
-Usually, it is just \"^/\". On W32 systems, there might be a
+Usually, it is just \"\\\\`/\". On W32 systems, there might be a
volume letter, which will be removed by `tramp-drop-volume-letter'.")
;;;###autoload
(defconst tramp-completion-file-name-regexp-unified
- (concat tramp-root-regexp "[^/]*$")
+ (concat tramp-root-regexp "[^/]*\\'")
"Value for `tramp-completion-file-name-regexp' for unified remoting.
GNU Emacs uses a unified filename syntax for Tramp and Ange-FTP.
See `tramp-file-name-structure' for more explanations.")
;;;###autoload
(defconst tramp-completion-file-name-regexp-separate
- (concat tramp-root-regexp "\\([[][^]]*\\)?$")
+ (concat tramp-root-regexp "\\([[][^]]*\\)?\\'")
"Value for `tramp-completion-file-name-regexp' for separate remoting.
XEmacs uses a separate filename syntax for Tramp and EFS.
See `tramp-file-name-structure' for more explanations.")
;;;###autoload
(defconst tramp-completion-file-name-regexp-url
- (concat tramp-root-regexp "[^/:]+\\(:\\(/\\(/[^/]*\\)?\\)?\\)?$")
+ (concat tramp-root-regexp "[^/:]+\\(:\\(/\\(/[^/]*\\)?\\)?\\)?\\'")
"Value for `tramp-completion-file-name-regexp' for URL-like remoting.
See `tramp-file-name-structure' for more explanations.")
;;; Internal Variables:
-(defvar tramp-end-of-output
- (format
- "///%s$"
- (md5 (concat (prin1-to-string process-environment) (current-time-string))))
- "String used to recognize end of output.
-The '$' character at the end is quoted; the string cannot be
-detected as prompt when being sent on echoing hosts, therefore.")
-
(defvar tramp-current-method nil
"Connection method for this *tramp* buffer.")
for this or `uudecode -p', but some systems don't, and for them
we have this shell function.")
+(defconst tramp-perl-file-truename
+ "%s -e '
+use File::Spec;
+use Cwd \"realpath\";
+
+sub recursive {
+ my ($volume, @dirs) = @_;
+ my $real = realpath(File::Spec->catpath(
+ $volume, File::Spec->catdir(@dirs), \"\"));
+ if ($real) {
+ my ($vol, $dir) = File::Spec->splitpath($real, 1);
+ return ($vol, File::Spec->splitdir($dir));
+ }
+ else {
+ my $last = pop(@dirs);
+ ($volume, @dirs) = recursive($volume, @dirs);
+ push(@dirs, $last);
+ return ($volume, @dirs);
+ }
+}
+
+$result = realpath($ARGV[0]);
+if (!$result) {
+ my ($vol, $dir) = File::Spec->splitpath($ARGV[0], 1);
+ ($vol, @dirs) = recursive($vol, File::Spec->splitdir($dir));
+
+ $result = File::Spec->catpath($vol, File::Spec->catdir(@dirs), \"\");
+}
+
+if ($ARGV[0] =~ /\\/$/) {
+ $result = $result . \"/\";
+}
+
+print \"\\\"$result\\\"\\n\";
+' \"$1\" 2>/dev/null"
+ "Perl script to produce output suitable for use with `file-truename'
+on the remote file system.
+Escape sequence %s is replaced with name of Perl binary.
+This string is passed to `format', so percent characters need to be doubled.")
+
+(defconst tramp-perl-file-name-all-completions
+ "%s -e 'sub case {
+ my $str = shift;
+ if ($ARGV[2]) {
+ return lc($str);
+ }
+ else {
+ return $str;
+ }
+}
+opendir(d, $ARGV[0]) || die(\"$ARGV[0]: $!\\nfail\\n\");
+@files = readdir(d); closedir(d);
+foreach $f (@files) {
+ if (case(substr($f, 0, length($ARGV[1]))) eq case($ARGV[1])) {
+ if (-d \"$ARGV[0]/$f\") {
+ print \"$f/\\n\";
+ }
+ else {
+ print \"$f\\n\";
+ }
+ }
+}
+print \"ok\\n\"
+' \"$1\" \"$2\" \"$3\" 2>/dev/null"
+ "Perl script to produce output suitable for use with
+`file-name-all-completions' on the remote file system. Escape
+sequence %s is replaced with name of Perl binary. This string is
+passed to `format', so percent characters need to be doubled.")
+
;; Perl script to implement `file-attributes' in a Lisp `read'able
;; output. If you are hacking on this, note that you get *no* output
;; unless this spits out a complete line, including the '\n' at the
(defconst tramp-perl-file-attributes
"%s -e '
@stat = lstat($ARGV[0]);
+if (!@stat) {
+ print \"nil\\n\";
+ exit 0;
+}
if (($stat[2] & 0170000) == 0120000)
{
$type = readlink($ARGV[0]);
(defconst tramp-perl-encode
"%s -e '
# This script contributed by Juanma Barranquero <lektu@terra.es>.
-# Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
+# Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
# Free Software Foundation, Inc.
use strict;
(defconst tramp-perl-decode
"%s -e '
# This script contributed by Juanma Barranquero <lektu@terra.es>.
-# Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
+# Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
# Free Software Foundation, Inc.
use strict;
Escape sequence %s is replaced with name of Perl binary.
This string is passed to `format', so percent characters need to be doubled.")
+(defconst tramp-vc-registered-read-file-names
+ "echo \"(\"
+for file in \"$@\"; do
+ if %s $file; then
+ echo \"(\\\"$file\\\" \\\"file-exists-p\\\" t)\"
+ else
+ echo \"(\\\"$file\\\" \\\"file-exists-p\\\" nil)\"
+ fi
+ if %s $file; then
+ echo \"(\\\"$file\\\" \\\"file-readable-p\\\" t)\"
+ else
+ echo \"(\\\"$file\\\" \\\"file-readable-p\\\" nil)\"
+ fi
+done
+echo \")\""
+ "Script to check existence of VC related files.
+It must be send formatted with two strings; the tests for file
+existence, and file readability.")
+
(defconst tramp-file-mode-type-map
'((0 . "-") ; Normal file (SVID-v2 and XPG2)
(1 . "p") ; fifo
(file-name-completion . tramp-handle-file-name-completion)
(add-name-to-file . tramp-handle-add-name-to-file)
(copy-file . tramp-handle-copy-file)
+ (copy-directory . tramp-handle-copy-directory)
(rename-file . tramp-handle-rename-file)
(set-file-modes . tramp-handle-set-file-modes)
(set-file-times . tramp-handle-set-file-times)
;; Handlers for foreign methods, like FTP or SMB, shall be plugged here.
(defvar tramp-foreign-file-name-handler-alist
;; (identity . tramp-sh-file-name-handler) should always be the last
- ;; entry, since `identity' always matches.
+ ;; entry, because `identity' always matches.
'((identity . tramp-sh-file-name-handler))
"Alist of elements (FUNCTION . HANDLER) for foreign methods handled specially.
If (FUNCTION FILENAME) returns non-nil, then all I/O on that file is done by
(unless (bolp)
(insert "\n"))
;; Timestamp.
- (insert (format-time-string "%T "))
+ (let ((now (current-time)))
+ (insert (format-time-string "%T." now))
+ (insert (format "%06d " (nth 2 now))))
;; Calling function.
(let ((btn 1) btf fn)
(while (not fn)
;; The message.
(insert (apply 'format fmt-string args)))))
+(defvar tramp-message-show-message t
+ "Show Tramp message in the minibuffer.
+This variable is used to disable messages from `tramp-error'.
+The messages are visible anyway, because an error is raised.")
+
(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
;; Match data must be preserved!
(save-match-data
;; Display only when there is a minimum level.
- (when (<= level 3)
+ (when (and tramp-message-show-message (<= level 3))
(apply 'message
(concat
(cond
VEC-OR-PROC identifies the connection to use, SIGNAL is the
signal identifier to be raised, remaining args passed to
`tramp-message'. Finally, signal SIGNAL is raised."
- (tramp-message
- vec-or-proc 1 "%s"
- (error-message-string
- (list signal (get signal 'error-message) (apply 'format fmt-string args))))
- (signal signal (list (apply 'format fmt-string args))))
+ (let (tramp-message-show-message)
+ (tramp-message
+ vec-or-proc 1 "%s"
+ (error-message-string
+ (list signal
+ (get signal 'error-message)
+ (apply 'format fmt-string args))))
+ (signal signal (list (apply 'format fmt-string args)))))
(defsubst tramp-error-with-buffer
(buffer vec-or-proc signal fmt-string &rest args)
(add-hook 'rfn-eshadow-setup-minibuffer-hook
'tramp-rfn-eshadow-setup-minibuffer)
(add-hook 'tramp-unload-hook
- '(lambda ()
- (remove-hook 'rfn-eshadow-setup-minibuffer-hook
- 'tramp-rfn-eshadow-setup-minibuffer))))
+ (lambda ()
+ (remove-hook 'rfn-eshadow-setup-minibuffer-hook
+ 'tramp-rfn-eshadow-setup-minibuffer))))
+
+(defconst tramp-rfn-eshadow-update-overlay-regexp
+ (format "[^%s/~]*\\(/\\|~\\)" tramp-postfix-host-format))
(defun tramp-rfn-eshadow-update-overlay ()
"Update `rfn-eshadow-overlay' to cover shadowed part of minibuffer input.
(save-excursion
(save-restriction
(narrow-to-region
- (1+ (or (string-match "/" (buffer-string) end) end)) (point-max))
+ (1+ (or (string-match
+ tramp-rfn-eshadow-update-overlay-regexp (buffer-string) end)
+ end))
+ (point-max))
(let ((rfn-eshadow-overlay tramp-rfn-eshadow-overlay)
(rfn-eshadow-update-overlay-hook nil))
(move-overlay rfn-eshadow-overlay (point-max) (point-max))
(when (boundp 'rfn-eshadow-update-overlay-hook)
(add-hook 'rfn-eshadow-update-overlay-hook
- 'tramp-rfn-eshadow-update-overlay))
+ 'tramp-rfn-eshadow-update-overlay)
+ (add-hook 'tramp-unload-hook
+ (lambda ()
+ (remove-hook 'rfn-eshadow-update-overlay-hook
+ 'tramp-rfn-eshadow-update-overlay))))
+
+
+;;; Integration of eshell.el:
+
+(eval-when-compile
+ (defvar eshell-path-env))
+
+;; eshell.el keeps the path in `eshell-path-env'. We must change it
+;; when `default-directory' points to another host.
+(defun tramp-eshell-directory-change ()
+ "Set `eshell-path-env' to $PATH of the host related to `default-directory'."
+ (setq eshell-path-env
+ (if (file-remote-p default-directory)
+ (with-parsed-tramp-file-name default-directory nil
+ (mapconcat
+ 'identity
+ (tramp-get-remote-path v)
+ ":"))
+ (getenv "PATH"))))
+
+(eval-after-load "esh-util"
+ '(progn
+ (tramp-eshell-directory-change)
+ (add-hook 'eshell-directory-change-hook
+ 'tramp-eshell-directory-change)
+ (add-hook 'tramp-unload-hook
+ (lambda ()
+ (remove-hook 'eshell-directory-change-hook
+ 'tramp-eshell-directory-change)))))
;;; File Name Handler Functions:
;; that FILENAME belongs to.
(zerop
(tramp-send-command-and-check
- l (format "cd %s && %s -sf %s %s" cwd ln filename l-localname) t)))))
+ l
+ (format
+ "cd %s && %s -sf %s %s"
+ (tramp-shell-quote-argument cwd)
+ ln
+ (tramp-shell-quote-argument filename)
+ (tramp-shell-quote-argument l-localname))
+ t)))))
(defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix)
"Like `load' for Tramp files."
"Like `file-truename' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name filename) nil
(with-file-property v localname "file-truename"
- (let* ((directory-sep-char ?/) ; for XEmacs
- (steps (tramp-compat-split-string localname "/"))
- (localnamedir (tramp-run-real-handler
- 'file-name-as-directory (list localname)))
- (is-dir (string= localname localnamedir))
- (thisstep nil)
- (numchase 0)
- ;; Don't make the following value larger than necessary.
- ;; People expect an error message in a timely fashion when
- ;; something is wrong; otherwise they might think that Emacs
- ;; is hung. Of course, correctness has to come first.
- (numchase-limit 20)
- (result nil) ;result steps in reverse order
- symlink-target)
+ (let ((result nil)) ; result steps in reverse order
(tramp-message v 4 "Finding true name for `%s'" filename)
- (while (and steps (< numchase numchase-limit))
- (setq thisstep (pop steps))
- (tramp-message
- v 5 "Check %s"
- (mapconcat 'identity
- (append '("") (reverse result) (list thisstep))
+ (cond
+ ;; Use GNU readlink --canonicalize-missing where available.
+ ((tramp-get-remote-readlink v)
+ (setq result
+ (tramp-send-command-and-read
+ v
+ (format "echo \"\\\"`%s --canonicalize-missing %s`\\\"\""
+ (tramp-get-remote-readlink v)
+ (tramp-shell-quote-argument localname)))))
+
+ ;; Use Perl implementation.
+ ((and (tramp-get-remote-perl v)
+ (tramp-get-connection-property v "perl-file-spec" nil)
+ (tramp-get-connection-property v "perl-cwd-realpath" nil))
+ (tramp-maybe-send-script
+ v tramp-perl-file-truename "tramp_perl_file_truename")
+ (setq result
+ (tramp-send-command-and-read
+ v
+ (format "tramp_perl_file_truename %s"
+ (tramp-shell-quote-argument localname)))))
+
+ ;; Do it yourself. We bind `directory-sep-char' here for
+ ;; XEmacs on Windows, which would otherwise use backslash.
+ (t (let* ((directory-sep-char ?/)
+ (steps (tramp-compat-split-string localname "/"))
+ (localnamedir (tramp-run-real-handler
+ 'file-name-as-directory (list localname)))
+ (is-dir (string= localname localnamedir))
+ (thisstep nil)
+ (numchase 0)
+ ;; Don't make the following value larger than
+ ;; necessary. People expect an error message in a
+ ;; timely fashion when something is wrong;
+ ;; otherwise they might think that Emacs is hung.
+ ;; Of course, correctness has to come first.
+ (numchase-limit 20)
+ symlink-target)
+ (while (and steps (< numchase numchase-limit))
+ (setq thisstep (pop steps))
+ (tramp-message
+ v 5 "Check %s"
+ (mapconcat 'identity
+ (append '("") (reverse result) (list thisstep))
+ "/"))
+ (setq symlink-target
+ (nth 0 (file-attributes
+ (tramp-make-tramp-file-name
+ method user host
+ (mapconcat 'identity
+ (append '("")
+ (reverse result)
+ (list thisstep))
+ "/")))))
+ (cond ((string= "." thisstep)
+ (tramp-message v 5 "Ignoring step `.'"))
+ ((string= ".." thisstep)
+ (tramp-message v 5 "Processing step `..'")
+ (pop result))
+ ((stringp symlink-target)
+ ;; It's a symlink, follow it.
+ (tramp-message v 5 "Follow symlink to %s" symlink-target)
+ (setq numchase (1+ numchase))
+ (when (file-name-absolute-p symlink-target)
+ (setq result nil))
+ ;; If the symlink was absolute, we'll get a string like
+ ;; "/user@host:/some/target"; extract the
+ ;; "/some/target" part from it.
+ (when (tramp-tramp-file-p symlink-target)
+ (unless (tramp-equal-remote filename symlink-target)
+ (tramp-error
+ v 'file-error
+ "Symlink target `%s' on wrong host" symlink-target))
+ (setq symlink-target localname))
+ (setq steps
+ (append (tramp-compat-split-string
+ symlink-target "/")
+ steps)))
+ (t
+ ;; It's a file.
+ (setq result (cons thisstep result)))))
+ (when (>= numchase numchase-limit)
+ (tramp-error
+ v 'file-error
+ "Maximum number (%d) of symlinks exceeded" numchase-limit))
+ (setq result (reverse result))
+ ;; Combine list to form string.
+ (setq result
+ (if result
+ (mapconcat 'identity (cons "" result) "/")
"/"))
- (setq symlink-target
- (nth 0 (file-attributes
- (tramp-make-tramp-file-name
- method user host
- (mapconcat 'identity
- (append '("")
- (reverse result)
- (list thisstep))
- "/")))))
- (cond ((string= "." thisstep)
- (tramp-message v 5 "Ignoring step `.'"))
- ((string= ".." thisstep)
- (tramp-message v 5 "Processing step `..'")
- (pop result))
- ((stringp symlink-target)
- ;; It's a symlink, follow it.
- (tramp-message v 5 "Follow symlink to %s" symlink-target)
- (setq numchase (1+ numchase))
- (when (file-name-absolute-p symlink-target)
- (setq result nil))
- ;; If the symlink was absolute, we'll get a string like
- ;; "/user@host:/some/target"; extract the
- ;; "/some/target" part from it.
- (when (tramp-tramp-file-p symlink-target)
- (unless (tramp-equal-remote filename symlink-target)
- (tramp-error
- v 'file-error
- "Symlink target `%s' on wrong host" symlink-target))
- (setq symlink-target localname))
- (setq steps
- (append (tramp-compat-split-string symlink-target "/")
- steps)))
- (t
- ;; It's a file.
- (setq result (cons thisstep result)))))
- (when (>= numchase numchase-limit)
- (tramp-error
- v 'file-error
- "Maximum number (%d) of symlinks exceeded" numchase-limit))
- (setq result (reverse result))
- ;; Combine list to form string.
- (setq result
- (if result
- (mapconcat 'identity (cons "" result) "/")
- "/"))
- (when (and is-dir (or (string= "" result)
- (not (string= (substring result -1) "/"))))
- (setq result (concat result "/")))
- (tramp-message v 4 "True name of `%s' is `%s'" filename result)
- (tramp-make-tramp-file-name method user host result)))))
+ (when (and is-dir (or (string= "" result)
+ (not (string= (substring result -1) "/"))))
+ (setq result (concat result "/"))))))
+
+ (tramp-message v 4 "True name of `%s' is `%s'" filename result)
+ (tramp-make-tramp-file-name method user host result)))))
;; Basic functions.
"Like `file-exists-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
(with-file-property v localname "file-exists-p"
- (zerop (tramp-send-command-and-check
- v
- (format
- "%s %s"
- (tramp-get-file-exists-command v)
- (tramp-shell-quote-argument localname)))))))
+ (or (not (null (tramp-get-file-property
+ v localname "file-attributes-integer" nil)))
+ (not (null (tramp-get-file-property
+ v localname "file-attributes-string" nil)))
+ (zerop (tramp-send-command-and-check
+ v
+ (format
+ "%s %s"
+ (tramp-get-file-exists-command v)
+ (tramp-shell-quote-argument localname))))))))
;; Inodes don't exist for some file systems. Therefore we must
;; generate virtual ones. Used in `find-buffer-visiting'. The method
(defun tramp-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
(unless id-format (setq id-format 'integer))
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-file-property v localname (format "file-attributes-%s" id-format)
- (when (file-exists-p filename)
- ;; file exists, find out stuff
+ ;; Don't modify `last-coding-system-used' by accident.
+ (let ((last-coding-system-used last-coding-system-used))
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (with-file-property v localname (format "file-attributes-%s" id-format)
(save-excursion
(tramp-convert-file-attributes
v
- (if (tramp-get-remote-stat v)
- (tramp-handle-file-attributes-with-stat v localname id-format)
- (if (tramp-get-remote-perl v)
- (tramp-handle-file-attributes-with-perl v localname id-format)
- (tramp-handle-file-attributes-with-ls
- v localname id-format)))))))))
-
-(defun tramp-handle-file-attributes-with-ls (vec localname &optional id-format)
+ (cond
+ ((tramp-get-remote-stat v)
+ (tramp-do-file-attributes-with-stat v localname id-format))
+ ((tramp-get-remote-perl v)
+ (tramp-do-file-attributes-with-perl v localname id-format))
+ (t
+ (tramp-do-file-attributes-with-ls v localname id-format)))))))))
+
+(defun tramp-do-file-attributes-with-ls (vec localname &optional id-format)
"Implement `file-attributes' for Tramp files using the ls(1) command."
(let (symlinkp dirp
res-inode res-filemodes res-numlinks
(tramp-message vec 5 "file attributes with ls: %s" localname)
(tramp-send-command
vec
- (format "%s %s %s"
+ (format "(%s %s || %s -h %s) && %s %s %s"
+ (tramp-get-file-exists-command vec)
+ (tramp-shell-quote-argument localname)
+ (tramp-get-test-command vec)
+ (tramp-shell-quote-argument localname)
(tramp-get-ls-command vec)
(if (eq id-format 'integer) "-ildn" "-ild")
(tramp-shell-quote-argument localname)))
;; parse `ls -l' output ...
(with-current-buffer (tramp-get-buffer vec)
- (goto-char (point-min))
- ;; ... inode
- (setq res-inode
- (condition-case err
- (read (current-buffer))
- (invalid-read-syntax
- (when (and (equal (cadr err)
- "Integer constant overflow in reader")
- (string-match
- "^[0-9]+\\([0-9][0-9][0-9][0-9][0-9]\\)\\'"
- (car (cddr err))))
- (let* ((big (read (substring (car (cddr err)) 0
- (match-beginning 1))))
- (small (read (match-string 1 (car (cddr err)))))
- (twiddle (/ small 65536)))
- (cons (+ big twiddle)
- (- small (* twiddle 65536))))))))
- ;; ... file mode flags
- (setq res-filemodes (symbol-name (read (current-buffer))))
- ;; ... number links
- (setq res-numlinks (read (current-buffer)))
- ;; ... uid and gid
- (setq res-uid (read (current-buffer)))
- (setq res-gid (read (current-buffer)))
- (if (eq id-format 'integer)
- (progn
- (unless (numberp res-uid) (setq res-uid -1))
- (unless (numberp res-gid) (setq res-gid -1)))
- (progn
- (unless (stringp res-uid) (setq res-uid (symbol-name res-uid)))
- (unless (stringp res-gid) (setq res-gid (symbol-name res-gid)))))
- ;; ... size
- (setq res-size (read (current-buffer)))
- ;; From the file modes, figure out other stuff.
- (setq symlinkp (eq ?l (aref res-filemodes 0)))
- (setq dirp (eq ?d (aref res-filemodes 0)))
- ;; if symlink, find out file name pointed to
- (when symlinkp
- (search-forward "-> ")
- (setq res-symlink-target
- (buffer-substring (point) (tramp-compat-line-end-position))))
- ;; return data gathered
- (list
- ;; 0. t for directory, string (name linked to) for symbolic
- ;; link, or nil.
- (or dirp res-symlink-target)
- ;; 1. Number of links to file.
- res-numlinks
- ;; 2. File uid.
- res-uid
- ;; 3. File gid.
- res-gid
- ;; 4. Last access time, as a list of two integers. First
- ;; integer has high-order 16 bits of time, second has low 16
- ;; bits.
- ;; 5. Last modification time, likewise.
- ;; 6. Last status change time, likewise.
- '(0 0) '(0 0) '(0 0) ;CCC how to find out?
- ;; 7. Size in bytes (-1, if number is out of range).
- res-size
- ;; 8. File modes, as a string of ten letters or dashes as in ls -l.
- res-filemodes
- ;; 9. t if file's gid would change if file were deleted and
- ;; recreated. Will be set in `tramp-convert-file-attributes'
- t
- ;; 10. inode number.
- res-inode
- ;; 11. Device number. Will be replaced by a virtual device number.
- -1
- ))))
-
-(defun tramp-handle-file-attributes-with-perl
+ (when (> (buffer-size) 0)
+ (goto-char (point-min))
+ ;; ... inode
+ (setq res-inode
+ (condition-case err
+ (read (current-buffer))
+ (invalid-read-syntax
+ (when (and (equal (cadr err)
+ "Integer constant overflow in reader")
+ (string-match
+ "^[0-9]+\\([0-9][0-9][0-9][0-9][0-9]\\)\\'"
+ (car (cddr err))))
+ (let* ((big (read (substring (car (cddr err)) 0
+ (match-beginning 1))))
+ (small (read (match-string 1 (car (cddr err)))))
+ (twiddle (/ small 65536)))
+ (cons (+ big twiddle)
+ (- small (* twiddle 65536))))))))
+ ;; ... file mode flags
+ (setq res-filemodes (symbol-name (read (current-buffer))))
+ ;; ... number links
+ (setq res-numlinks (read (current-buffer)))
+ ;; ... uid and gid
+ (setq res-uid (read (current-buffer)))
+ (setq res-gid (read (current-buffer)))
+ (if (eq id-format 'integer)
+ (progn
+ (unless (numberp res-uid) (setq res-uid -1))
+ (unless (numberp res-gid) (setq res-gid -1)))
+ (progn
+ (unless (stringp res-uid) (setq res-uid (symbol-name res-uid)))
+ (unless (stringp res-gid) (setq res-gid (symbol-name res-gid)))))
+ ;; ... size
+ (setq res-size (read (current-buffer)))
+ ;; From the file modes, figure out other stuff.
+ (setq symlinkp (eq ?l (aref res-filemodes 0)))
+ (setq dirp (eq ?d (aref res-filemodes 0)))
+ ;; if symlink, find out file name pointed to
+ (when symlinkp
+ (search-forward "-> ")
+ (setq res-symlink-target
+ (buffer-substring (point) (tramp-compat-line-end-position))))
+ ;; return data gathered
+ (list
+ ;; 0. t for directory, string (name linked to) for symbolic
+ ;; link, or nil.
+ (or dirp res-symlink-target)
+ ;; 1. Number of links to file.
+ res-numlinks
+ ;; 2. File uid.
+ res-uid
+ ;; 3. File gid.
+ res-gid
+ ;; 4. Last access time, as a list of two integers. First
+ ;; integer has high-order 16 bits of time, second has low 16
+ ;; bits.
+ ;; 5. Last modification time, likewise.
+ ;; 6. Last status change time, likewise.
+ '(0 0) '(0 0) '(0 0) ;CCC how to find out?
+ ;; 7. Size in bytes (-1, if number is out of range).
+ res-size
+ ;; 8. File modes, as a string of ten letters or dashes as in ls -l.
+ res-filemodes
+ ;; 9. t if file's gid would change if file were deleted and
+ ;; recreated. Will be set in `tramp-convert-file-attributes'
+ t
+ ;; 10. inode number.
+ res-inode
+ ;; 11. Device number. Will be replaced by a virtual device number.
+ -1
+ )))))
+
+(defun tramp-do-file-attributes-with-perl
(vec localname &optional id-format)
"Implement `file-attributes' for Tramp files using a Perl script."
(tramp-message vec 5 "file attributes with perl: %s" localname)
(format "tramp_perl_file_attributes %s %s"
(tramp-shell-quote-argument localname) id-format)))
-(defun tramp-handle-file-attributes-with-stat
+(defun tramp-do-file-attributes-with-stat
(vec localname &optional id-format)
"Implement `file-attributes' for Tramp files using stat(1) command."
(tramp-message vec 5 "file attributes with stat: %s" localname)
(tramp-send-command-and-read
vec
(format
- "%s -c '((\"%%N\") %%h %s %s %%X.0 %%Y.0 %%Z.0 %%s.0 \"%%A\" t %%i.0 -1)' %s"
+ "((%s %s || %s -h %s) && %s -c '((\"%%N\") %%h %s %s %%X.0 %%Y.0 %%Z.0 %%s.0 \"%%A\" t %%i.0 -1)' %s || echo nil)"
+ (tramp-get-file-exists-command vec)
+ (tramp-shell-quote-argument localname)
+ (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\"")
(when (boundp 'last-coding-system-used)
(setq coding-system-used (symbol-value 'last-coding-system-used)))
;; We use '(0 0) as a don't-know value. See also
- ;; `tramp-handle-file-attributes-with-ls'.
+ ;; `tramp-do-file-attributes-with-ls'.
(if (not (equal modtime '(0 0)))
(tramp-run-real-handler 'set-visited-file-modtime (list modtime))
(progn
;; another implementation, see `dired-do-chown'. OTOH, it is mostly
;; working with su(do)? when it is needed, so it shall succeed in
;; the majority of cases.
- (if (file-remote-p filename)
- (with-parsed-tramp-file-name filename nil
- (if (and (zerop (user-uid)) (tramp-local-host-p v))
- ;; If we are root on the local host, we can do it directly.
- (tramp-set-file-uid-gid localname uid gid)
- (let ((uid (or (and (integerp uid) uid)
- (tramp-get-remote-uid v 'integer)))
- (gid (or (and (integerp gid) gid)
- (tramp-get-remote-gid v 'integer))))
- (tramp-send-command
- v (format
- "chown %d:%d %s" uid gid
- (tramp-shell-quote-argument localname))))))
-
- ;; We handle also the local part, because there doesn't exist
- ;; `set-file-uid-gid'. On W32 "chown" might not work.
- (let ((uid (or (and (integerp uid) uid) (tramp-get-local-uid 'integer)))
- (gid (or (and (integerp gid) gid) (tramp-get-local-gid 'integer))))
- (tramp-local-call-process
- "chown" nil nil nil
- (format "%d:%d" uid gid) (tramp-shell-quote-argument filename)))))
+ ;; Don't modify `last-coding-system-used' by accident.
+ (let ((last-coding-system-used last-coding-system-used))
+ (if (file-remote-p filename)
+ (with-parsed-tramp-file-name filename nil
+ (if (and (zerop (user-uid)) (tramp-local-host-p v))
+ ;; If we are root on the local host, we can do it directly.
+ (tramp-set-file-uid-gid localname uid gid)
+ (let ((uid (or (and (integerp uid) uid)
+ (tramp-get-remote-uid v 'integer)))
+ (gid (or (and (integerp gid) gid)
+ (tramp-get-remote-gid v 'integer))))
+ (tramp-send-command
+ v (format
+ "chown %d:%d %s" uid gid
+ (tramp-shell-quote-argument localname))))))
+
+ ;; We handle also the local part, because there doesn't exist
+ ;; `set-file-uid-gid'. On W32 "chown" might not work.
+ (let ((uid (or (and (integerp uid) uid) (tramp-get-local-uid 'integer)))
+ (gid (or (and (integerp gid) gid) (tramp-get-local-gid 'integer))))
+ (tramp-local-call-process
+ "chown" nil nil nil
+ (format "%d:%d" uid gid) (tramp-shell-quote-argument filename))))))
;; Simple functions using the `test' command.
"Like `file-executable-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
(with-file-property v localname "file-executable-p"
- (zerop (tramp-run-test "-x" filename)))))
+ ;; Examine `file-attributes' cache to see if request can be
+ ;; satisfied without remote operation.
+ (or (tramp-check-cached-permissions v ?x)
+ (zerop (tramp-run-test "-x" filename))))))
(defun tramp-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
(with-file-property v localname "file-readable-p"
- (zerop (tramp-run-test "-r" filename)))))
+ ;; Examine `file-attributes' cache to see if request can be
+ ;; satisfied without remote operation.
+ (or (tramp-check-cached-permissions v ?r)
+ (zerop (tramp-run-test "-r" filename))))))
;; When the remote shell is started, it looks for a shell which groks
;; tilde expansion. Here, we assume that all shells which grok tilde
(with-parsed-tramp-file-name filename nil
(with-file-property v localname "file-writable-p"
(if (file-exists-p filename)
- ;; Existing files must be writable.
- (zerop (tramp-run-test "-w" filename))
+ ;; Examine `file-attributes' cache to see if request can be
+ ;; satisfied without remote operation.
+ (or (tramp-check-cached-permissions v ?w)
+ (zerop (tramp-run-test "-w" filename)))
;; If file doesn't exist, check if directory is writable.
(and (zerop (tramp-run-test
"-d" (file-name-directory filename)))
(format "directory-files-and-attributes-%s" id-format)
(save-excursion
(mapcar
- '(lambda (x)
- (cons (car x)
- (tramp-convert-file-attributes v (cdr x))))
- (if (tramp-get-remote-stat v)
- (tramp-handle-directory-files-and-attributes-with-stat
- v localname id-format)
- (if (tramp-get-remote-perl v)
- (tramp-handle-directory-files-and-attributes-with-perl
- v localname id-format)))))))))
+ (lambda (x)
+ (cons (car x)
+ (tramp-convert-file-attributes v (cdr x))))
+ (cond
+ ((tramp-get-remote-stat v)
+ (tramp-do-directory-files-and-attributes-with-stat
+ v localname id-format))
+ ((tramp-get-remote-perl v)
+ (tramp-do-directory-files-and-attributes-with-perl
+ v localname id-format)))))))))
result item)
(while temp
result
(sort result (lambda (x y) (string< (car x) (car y))))))))
-(defun tramp-handle-directory-files-and-attributes-with-perl
+(defun tramp-do-directory-files-and-attributes-with-perl
(vec localname &optional id-format)
"Implement `directory-files-and-attributes' for Tramp files using a Perl script."
(tramp-message vec 5 "directory-files-and-attributes with perl: %s" localname)
(when (stringp object) (tramp-error vec 'file-error object))
object))
-(defun tramp-handle-directory-files-and-attributes-with-stat
+(defun tramp-do-directory-files-and-attributes-with-stat
(vec localname &optional id-format)
"Implement `directory-files-and-attributes' for Tramp files using stat(1) command."
(tramp-message vec 5 "directory-files-and-attributes with stat: %s" localname)
"Like `file-name-all-completions' for Tramp files."
(unless (save-match-data (string-match "/" filename))
(with-parsed-tramp-file-name (expand-file-name directory) nil
- ;; Flush the directory cache. There could be changed directory
- ;; contents.
- (when (and (integerp tramp-completion-reread-directory-timeout)
- (> (tramp-time-diff
- (current-time)
- (tramp-get-file-property
- v localname "last-completion" '(0 0 0)))
- tramp-completion-reread-directory-timeout))
- (tramp-flush-file-property v localname))
(all-completions
filename
(mapcar
'list
- (with-file-property v localname "file-name-all-completions"
- (let (result)
- (tramp-barf-unless-okay
- v
- (format "cd %s" (tramp-shell-quote-argument localname))
- "tramp-handle-file-name-all-completions: Couldn't `cd %s'"
- (tramp-shell-quote-argument localname))
-
- ;; Get a list of directories and files, including reliably
- ;; tagging the directories with a trailing '/'. Because I
- ;; rock. --daniel@danann.net
- (tramp-send-command
- v
- (format (concat "%s -a 2>/dev/null | while read f; do "
- "if %s -d \"$f\" 2>/dev/null; "
- "then echo \"$f/\"; else echo \"$f\"; fi; done")
- (tramp-get-ls-command v)
- (tramp-get-test-command v)))
-
- ;; Now grab the output.
- (with-current-buffer (tramp-get-buffer v)
- (goto-char (point-max))
- (while (zerop (forward-line -1))
- (push (buffer-substring
- (point) (tramp-compat-line-end-position))
- result)))
-
- (tramp-set-file-property
- v localname "last-completion" (current-time))
- result)))))))
+ (or
+ ;; Try cache first
+ (and
+ ;; Ignore if expired
+ (or (not (integerp tramp-completion-reread-directory-timeout))
+ (<= (tramp-time-diff
+ (current-time)
+ (tramp-get-file-property
+ v localname "last-completion" '(0 0 0)))
+ tramp-completion-reread-directory-timeout))
+
+ ;; Try cache entries for filename, filename with last
+ ;; character removed, filename with last two characters
+ ;; removed, ..., and finally the empty string - all
+ ;; concatenated to the local directory name
+
+ ;; This is inefficient for very long filenames, pity
+ ;; `reduce' is not available...
+ (car
+ (apply
+ 'append
+ (mapcar
+ (lambda (x)
+ (let ((cache-hit
+ (tramp-get-file-property
+ v
+ (concat localname (substring filename 0 x))
+ "file-name-all-completions"
+ nil)))
+ (when cache-hit (list cache-hit))))
+ (tramp-compat-number-sequence (length filename) 0 -1)))))
+
+ ;; Cache expired or no matching cache entry found so we need
+ ;; to perform a remote operation
+ (let (result)
+ ;; Get a list of directories and files, including reliably
+ ;; tagging the directories with a trailing '/'. Because I
+ ;; rock. --daniel@danann.net
+
+ ;; Changed to perform `cd' in the same remote op and only
+ ;; get entries starting with `filename'. Capture any `cd'
+ ;; error messages. Ensure any `cd' and `echo' aliases are
+ ;; ignored.
+ (tramp-send-command
+ v
+ (if (tramp-get-remote-perl v)
+ (progn
+ (tramp-maybe-send-script
+ v tramp-perl-file-name-all-completions
+ "tramp_perl_file_name_all_completions")
+ (format "tramp_perl_file_name_all_completions %s %s %d"
+ (tramp-shell-quote-argument localname)
+ (tramp-shell-quote-argument filename)
+ (if (symbol-value
+ 'read-file-name-completion-ignore-case)
+ 1 0)))
+
+ (format (concat
+ "(\\cd %s 2>&1 && (%s %s -a 2>/dev/null"
+ ;; `ls' with wildcard might fail with `Argument
+ ;; list too long' error in some corner cases; if
+ ;; `ls' fails after `cd' succeeded, chances are
+ ;; that's the case, so let's retry without
+ ;; wildcard. This will return "too many" entries
+ ;; but that isn't harmful.
+ " || %s -a 2>/dev/null)"
+ " | while read f; do"
+ " if %s -d \"$f\" 2>/dev/null;"
+ " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done"
+ " && \\echo ok) || \\echo fail")
+ (tramp-shell-quote-argument localname)
+ (tramp-get-ls-command v)
+ ;; When `filename' is empty, just `ls' without
+ ;; filename argument is more efficient than `ls *'
+ ;; for very large directories and might avoid the
+ ;; `Argument list too long' error.
+ ;;
+ ;; With and only with wildcard, we need to add
+ ;; `-d' to prevent `ls' from descending into
+ ;; sub-directories.
+ (if (zerop (length filename))
+ "."
+ (concat (tramp-shell-quote-argument filename) "* -d"))
+ (tramp-get-ls-command v)
+ (tramp-get-test-command v))))
+
+ ;; Now grab the output.
+ (with-current-buffer (tramp-get-buffer v)
+ (goto-char (point-max))
+
+ ;; Check result code, found in last line of output
+ (forward-line -1)
+ (if (looking-at "^fail$")
+ (progn
+ ;; Grab error message from line before last line
+ ;; (it was put there by `cd 2>&1')
+ (forward-line -1)
+ (tramp-error
+ v 'file-error
+ "tramp-handle-file-name-all-completions: %s"
+ (buffer-substring
+ (point) (tramp-compat-line-end-position))))
+ ;; For peace of mind, if buffer doesn't end in `fail'
+ ;; then it should end in `ok'. If neither are in the
+ ;; buffer something went seriously wrong on the remote
+ ;; side.
+ (unless (looking-at "^ok$")
+ (tramp-error
+ v 'file-error
+ "\
+tramp-handle-file-name-all-completions: internal error accessing `%s': `%s'"
+ (tramp-shell-quote-argument localname) (buffer-string))))
+
+ (while (zerop (forward-line -1))
+ (push (buffer-substring
+ (point) (tramp-compat-line-end-position))
+ result)))
+
+ ;; Because the remote op went through OK we know the
+ ;; directory we `cd'-ed to exists
+ (tramp-set-file-property
+ v localname "file-exists-p" t)
+
+ ;; Because the remote op went through OK we know every
+ ;; file listed by `ls' exists.
+ (mapc (lambda (entry)
+ (tramp-set-file-property
+ v (concat localname entry) "file-exists-p" t))
+ result)
+
+ (tramp-set-file-property
+ v localname "last-completion" (current-time))
+
+ ;; Store result in the cache
+ (tramp-set-file-property
+ v (concat localname filename)
+ "file-name-all-completions"
+ result))))))))
;; The following isn't needed for Emacs 20 but for 19.34?
(defun tramp-handle-file-name-completion
(tramp-run-real-handler
'copy-file (list filename newname ok-if-already-exists keep-date)))))
+(defun tramp-handle-copy-directory (dirname newname &optional keep-date parents)
+ "Like `copy-directory' for Tramp files."
+ (let ((t1 (tramp-tramp-file-p dirname))
+ (t2 (tramp-tramp-file-p newname)))
+ (with-parsed-tramp-file-name (if t1 dirname newname) nil
+ (if (and (tramp-get-method-parameter method 'tramp-copy-recursive)
+ ;; When DIRNAME and NEWNAME are remote, they must have
+ ;; the same method.
+ (or (null t1) (null t2)
+ (string-equal
+ (tramp-file-name-method (tramp-dissect-file-name dirname))
+ (tramp-file-name-method (tramp-dissect-file-name newname)))))
+ ;; scp or rsync DTRT.
+ (progn
+ (setq dirname (directory-file-name (expand-file-name dirname))
+ newname (directory-file-name (expand-file-name newname)))
+ (if (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 (not (file-directory-p (file-name-directory newname)))
+ (make-directory (file-name-directory newname) parents))
+ (tramp-do-copy-or-rename-file-out-of-band
+ 'copy dirname newname keep-date))
+ ;; We must do it file-wise.
+ (tramp-run-real-handler
+ 'copy-directory (list dirname newname keep-date parents))))))
+
(defun tramp-handle-rename-file
(filename newname &optional ok-if-already-exists)
"Like `rename-file' for Tramp files."
(tramp-error
v 'file-already-exists "File %s already exists" newname)))
+ (with-parsed-tramp-file-name (if t1 filename newname) nil
+ (tramp-message v 0 "Transferring %s to %s..." filename newname))
+
(prog1
(cond
;; Both are Tramp files.
op filename newname
ok-if-already-exists keep-date preserve-uid-gid))
- ;; If both source and target are Tramp files,
- ;; both are using the same copy-program, then we
- ;; can invoke rcp directly. Note that
- ;; default-directory should point to a local
- ;; directory if we want to invoke rcp.
- ((and (equal v1-method v2-method)
- (tramp-method-out-of-band-p v1)
- (> (nth 7 (file-attributes filename))
- tramp-copy-size-limit))
+ ;; Try out-of-band operation.
+ ((tramp-method-out-of-band-p
+ v1 (nth 7 (file-attributes filename)))
(tramp-do-copy-or-rename-file-out-of-band
op filename newname keep-date))
;; If the Tramp file has an out-of-band method, the corresponding
;; copy-program can be invoked.
- ((and (tramp-method-out-of-band-p v)
- (> (nth 7 (file-attributes filename))
- tramp-copy-size-limit))
+ ((tramp-method-out-of-band-p v (nth 7 (file-attributes filename)))
(tramp-do-copy-or-rename-file-out-of-band
op filename newname keep-date))
;; When newname did exist, we have wrong cached values.
(when t2
(with-parsed-tramp-file-name newname nil
- (tramp-flush-file-property v localname))))))
+ (tramp-flush-file-property v localname)))
+
+ (with-parsed-tramp-file-name (if t1 filename newname) nil
+ (tramp-message v 0 "Transferring %s to %s...done" filename newname)))))
(defun tramp-do-copy-or-rename-file-via-buffer (op filename newname keep-date)
"Use an Emacs buffer to copy or rename a file.
(if t1 (tramp-handle-file-remote-p filename 'localname) filename))
(localname2
(if t2 (tramp-handle-file-remote-p newname 'localname) newname))
- (prefix (file-remote-p (if t1 filename newname))))
+ (prefix (file-remote-p (if t1 filename newname)))
+ cmd-result)
(cond
;; Both files are on a remote host, with same user.
((and t1 t2)
- (tramp-send-command
- v
- (format "%s %s %s" cmd
- (tramp-shell-quote-argument localname1)
- (tramp-shell-quote-argument localname2)))
+ (setq cmd-result
+ (tramp-send-command-and-check
+ v
+ (format "%s %s %s" cmd
+ (tramp-shell-quote-argument localname1)
+ (tramp-shell-quote-argument localname2))))
(with-current-buffer (tramp-get-buffer v)
(goto-char (point-min))
(unless
;; Mask cp -f error.
(re-search-forward
tramp-operation-not-permitted-regexp nil t))
- (zerop (tramp-send-command-and-check v nil)))
+ (zerop cmd-result))
(tramp-error-with-buffer
nil v 'file-error
"Copying directly failed, see buffer `%s' for details."
'rename-file (list localname1 localname2 ok-if-already-exists))))
;; We can do it directly with `tramp-send-command'
- ((let (file-name-handler-alist)
- (and (file-readable-p (concat prefix localname1))
- (file-writable-p
- (file-name-directory (concat prefix localname2)))))
+ ((and (file-readable-p (concat prefix localname1))
+ (file-writable-p
+ (file-name-directory (concat prefix localname2)))
+ (or (file-directory-p (concat prefix localname2))
+ (file-writable-p (concat prefix localname2))))
(tramp-do-copy-or-rename-file-directly
op (concat prefix localname1) (concat prefix localname2)
ok-if-already-exists keep-date t)
(defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date)
"Invoke rcp program to copy.
-One of FILENAME and NEWNAME must be a Tramp name, the other must
-be a local filename. The method used must be an out-of-band method."
+The method used must be an out-of-band method."
(let ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p newname))
- copy-program copy-args copy-keep-date port spec
+ copy-program copy-args copy-env copy-keep-date port spec
source target)
(with-parsed-tramp-file-name (if t1 filename newname) nil
+ (if (and t1 t2)
- ;; Expand hops. Might be necessary for gateway methods.
- (setq v (car (tramp-compute-multi-hops v)))
- (aset v 3 localname)
-
- ;; Check which ones of source and target are Tramp files.
- (setq source (if t1 (tramp-make-copy-program-file-name v) filename)
- target (if t2 (tramp-make-copy-program-file-name v) newname))
-
- ;; Check for port number. Until now, there's no need for handling
- ;; like method, user, host.
- (setq host (tramp-file-name-real-host v)
- port (tramp-file-name-port v)
- port (or (and port (number-to-string port)) ""))
-
- ;; Compose copy command.
- (setq spec `((?h . ,host) (?u . ,user) (?p . ,port)
- (?t . ,(tramp-get-connection-property
- (tramp-get-connection-process v) "temp-file" ""))
- (?k . ,(if keep-date " " "")))
- copy-program (tramp-get-method-parameter
- method 'tramp-copy-program)
- copy-keep-date (tramp-get-method-parameter
- method 'tramp-copy-keep-date)
- copy-args
- (delq
- nil
- (mapcar
- '(lambda (x)
- (setq
- ;; " " is indication for keep-date argument.
- x (delete " " (mapcar '(lambda (y) (format-spec y spec)) x)))
- (unless (member "" x) (mapconcat 'identity x " ")))
- (tramp-get-method-parameter method 'tramp-copy-args))))
-
- ;; Check for program.
- (when (and (fboundp 'executable-find)
- (not (let ((default-directory
- (tramp-compat-temporary-file-directory)))
- (executable-find copy-program))))
- (tramp-error
- v 'file-error "Cannot find copy program: %s" copy-program))
-
- (tramp-message v 0 "Transferring %s to %s..." filename newname)
+ ;; Both are Tramp files. We shall optimize it, when the
+ ;; methods for filename and newname are the same.
+ (let ((tmpfile (tramp-compat-make-temp-file localname)))
+ (unwind-protect
+ (progn
+ (tramp-do-copy-or-rename-file-out-of-band
+ op filename tmpfile keep-date)
+ (tramp-do-copy-or-rename-file-out-of-band
+ 'rename tmpfile newname keep-date))
+ ;; Save exit.
+ (condition-case nil
+ (delete-file tmpfile)
+ (error))))
+
+ ;; Expand hops. Might be necessary for gateway methods.
+ (setq v (car (tramp-compute-multi-hops v)))
+ (aset v 3 localname)
+
+ ;; Check which ones of source and target are Tramp files.
+ (setq source (if t1 (tramp-make-copy-program-file-name v) filename)
+ target (funcall
+ (if (and (file-directory-p filename)
+ (string-equal
+ (file-name-nondirectory filename)
+ (file-name-nondirectory newname)))
+ 'file-name-directory
+ 'identity)
+ (if t2 (tramp-make-copy-program-file-name v) newname)))
+
+ ;; Check for port number. Until now, there's no need for handling
+ ;; like method, user, host.
+ (setq host (tramp-file-name-real-host v)
+ port (tramp-file-name-port v)
+ port (or (and port (number-to-string port)) ""))
+
+ ;; Compose copy command.
+ (setq spec `((?h . ,host) (?u . ,user) (?p . ,port)
+ (?t . ,(tramp-get-connection-property
+ (tramp-get-connection-process v) "temp-file" ""))
+ (?k . ,(if keep-date " " "")))
+ copy-program (tramp-get-method-parameter
+ method 'tramp-copy-program)
+ copy-keep-date (tramp-get-method-parameter
+ method 'tramp-copy-keep-date)
+ copy-args
+ (delq
+ nil
+ (mapcar
+ (lambda (x)
+ (setq
+ x
+ ;; " " is indication for keep-date argument.
+ (delete " " (mapcar (lambda (y) (format-spec y spec)) x)))
+ (unless (member "" x) (mapconcat 'identity x " ")))
+ (tramp-get-method-parameter method 'tramp-copy-args)))
+ copy-env
+ (delq
+ nil
+ (mapcar
+ (lambda (x)
+ (setq x (mapcar (lambda (y) (format-spec y spec)) x))
+ (unless (member "" x) (mapconcat 'identity x " ")))
+ (tramp-get-method-parameter method 'tramp-copy-env))))
+
+ ;; Check for program.
+ (when (and (fboundp 'executable-find)
+ (not (let ((default-directory
+ (tramp-compat-temporary-file-directory)))
+ (executable-find copy-program))))
+ (tramp-error
+ v 'file-error "Cannot find copy program: %s" copy-program))
- (unwind-protect
- (with-temp-buffer
- ;; The default directory must be remote.
- (let ((default-directory
- (file-name-directory (if t1 filename newname))))
- ;; 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))
-
- ;; Use an asynchronous process. By this, password can
- ;; be handled. The default directory must be local, in
- ;; order to apply the correct `copy-program'. We don't
- ;; set a timeout, because the copying of large files can
- ;; last longer than 60 secs.
- (let ((p (let ((default-directory
- (tramp-compat-temporary-file-directory)))
- (apply 'start-process
- (tramp-get-connection-property
- v "process-name" nil)
- (tramp-get-connection-property
- v "process-buffer" nil)
- copy-program
- (append copy-args (list source target))))))
- (tramp-message
- v 6 "%s" (mapconcat 'identity (process-command p) " "))
- (tramp-set-process-query-on-exit-flag p nil)
- (tramp-process-actions p v tramp-actions-copy-out-of-band))))
+ ;; Set variables for computing the prompt for reading
+ ;; password.
+ (setq tramp-current-method (tramp-file-name-method v)
+ tramp-current-user (tramp-file-name-user v)
+ tramp-current-host (tramp-file-name-host v))
- ;; Reset the transfer process properties.
- (tramp-set-connection-property v "process-name" nil)
- (tramp-set-connection-property v "process-buffer" nil))
+ (unwind-protect
+ (with-temp-buffer
+ ;; The default directory must be remote.
+ (let ((default-directory
+ (file-name-directory (if t1 filename newname)))
+ (process-environment (copy-sequence process-environment)))
+ ;; 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))
+ (while copy-env
+ (tramp-message v 5 "%s=\"%s\"" (car copy-env) (cadr copy-env))
+ (setenv (pop copy-env) (pop copy-env)))
+
+ ;; Use an asynchronous process. By this, password can
+ ;; be handled. The default directory must be local, in
+ ;; order to apply the correct `copy-program'. We don't
+ ;; set a timeout, because the copying of large files can
+ ;; last longer than 60 secs.
+ (let ((p (let ((default-directory
+ (tramp-compat-temporary-file-directory)))
+ (apply 'start-process
+ (tramp-get-connection-property
+ v "process-name" nil)
+ (tramp-get-connection-property
+ v "process-buffer" nil)
+ copy-program
+ (append copy-args (list source target))))))
+ (tramp-message
+ v 6 "%s" (mapconcat 'identity (process-command p) " "))
+ (tramp-set-process-query-on-exit-flag p nil)
+ (tramp-process-actions p v tramp-actions-copy-out-of-band))))
- (tramp-message v 0 "Transferring %s to %s...done" filename newname)
+ ;; Reset the transfer process properties.
+ (tramp-set-connection-property v "process-name" nil)
+ (tramp-set-connection-property v "process-buffer" nil))
- ;; Handle KEEP-DATE argument.
- (when (and keep-date (not copy-keep-date))
- (set-file-times newname (nth 5 (file-attributes filename))))
+ ;; Handle KEEP-DATE argument.
+ (when (and keep-date (not copy-keep-date))
+ (set-file-times newname (nth 5 (file-attributes filename))))
- ;; Set the mode.
- (unless (and keep-date copy-keep-date)
- (set-file-modes newname (tramp-default-file-modes filename))))
+ ;; Set the mode.
+ (unless (and keep-date copy-keep-date)
+ (set-file-modes newname (tramp-default-file-modes filename))))
- ;; If the operation was `rename', delete the original file.
- (unless (eq op 'copy)
- (delete-file filename))))
+ ;; If the operation was `rename', delete the original file.
+ (unless (eq op 'copy)
+ (delete-file filename)))))
(defun tramp-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
(setq dir (expand-file-name dir))
(with-parsed-tramp-file-name dir nil
+ (tramp-flush-directory-property v (file-name-directory localname))
(save-excursion
(tramp-barf-unless-okay
v
(tramp-shell-quote-argument localname))
"Couldn't make directory %s" dir))))
-(defun tramp-handle-delete-directory (directory)
+(defun tramp-handle-delete-directory (directory &optional recursive)
"Like `delete-directory' for Tramp files."
(setq directory (expand-file-name directory))
(with-parsed-tramp-file-name directory nil
(tramp-flush-directory-property v localname)
(unless (zerop (tramp-send-command-and-check
v
- (format "rmdir %s" (tramp-shell-quote-argument localname))))
+ (format
+ "%s %s"
+ (if recursive "rm -rf" "rmdir")
+ (tramp-shell-quote-argument localname))))
(tramp-error v 'file-error "Couldn't delete %s" directory))))
(defun tramp-handle-delete-file (filename)
"Recursively delete the directory given.
This is like `dired-recursive-delete-directory' for Tramp files."
(with-parsed-tramp-file-name filename nil
- (tramp-flush-directory-property v localname)
;; Run a shell command 'rm -r <localname>'
;; Code shamelessly stolen from the dired implementation and, um, hacked :)
(unless (file-exists-p filename)
;; This might take a while, allow it plenty of time.
(tramp-wait-for-output (tramp-get-connection-process v) 120)
;; Make sure that it worked...
+ (tramp-flush-directory-property v localname)
(and (file-exists-p filename)
(tramp-error
v 'file-error "Failed to recursively delete %s" filename))))
;; XEmacs has `dired-compression-method-alist', which is
;; transformed into `dired-compress-file-suffixes' structure.
(mapcar
- '(lambda (x)
- (list (concat (regexp-quote (nth 1 x)) "\\'")
- nil
- (mapconcat 'identity (nth 3 x) " ")))
+ (lambda (x)
+ (list (concat (regexp-quote (nth 1 x)) "\\'")
+ nil
+ (mapconcat 'identity (nth 3 x) " ")))
(symbol-value 'dired-compression-method-alist))))
suffix)
;; See if any suffix rule matches this file name.
;; We found an uncompression rule.
(tramp-message v 0 "Uncompressing %s..." file)
(when (zerop (tramp-send-command-and-check
- v (concat (nth 2 suffix) " " localname)))
+ v (concat (nth 2 suffix) " "
+ (tramp-shell-quote-argument localname))))
(tramp-message v 0 "Uncompressing %s...done" file)
;; `dired-remove-file' is not defined in XEmacs
(funcall (symbol-function 'dired-remove-file) file)
;; Try gzip.
(tramp-message v 0 "Compressing %s..." file)
(when (zerop (tramp-send-command-and-check
- v (concat "gzip -f " localname)))
+ v (concat "gzip -f "
+ (tramp-shell-quote-argument localname))))
(tramp-message v 0 "Compressing %s...done" file)
;; `dired-remove-file' is not defined in XEmacs
(funcall (symbol-function 'dired-remove-file) file)
(not (symbol-value 'ls-lisp-use-insert-directory-program)))
(tramp-run-real-handler
'insert-directory (list filename switches wildcard full-directory-p))
- ;; For the moment, we assume that the remote "ls" program does not
- ;; grok "--dired". In the future, we should detect this on
- ;; connection setup.
- (when (string-match "^--dired\\s-+" switches)
+ (when (and (string-match "^--dired\\s-+" switches)
+ (not (tramp-get-ls-command-with-dired v)))
(setq switches (replace-match "" nil t switches)))
(tramp-message
v 4 "Inserting directory `ls %s %s', wildcard %s, fulldir %s"
(setq switches (concat "-d " switches)))
(when wildcard
(setq switches (concat switches " " wildcard)))
+ (when (string-match "'" switches)
+ (setq switches (replace-match "\\\\'" nil nil switches)))
;; If `full-directory-p', we just say `ls -l FILENAME'.
;; Else we chdir to the parent directory, then say `ls -ld BASENAME'.
(if full-directory-p
(tramp-send-command
v
- (format "%s %s %s"
+ (format "%s %s %s 2>/dev/null"
(tramp-get-ls-command v)
switches
(if wildcard
(tramp-shell-quote-argument
(tramp-run-real-handler
'file-name-nondirectory (list localname)))))))
- ;; We cannot use `insert-buffer-substring' because the Tramp buffer
- ;; changes its contents before insertion due to calling
- ;; `expand-file' and alike.
- (insert
- (with-current-buffer (tramp-get-buffer v)
- (buffer-string))))))
+ (let ((beg (point)))
+ ;; We cannot use `insert-buffer-substring' because the Tramp
+ ;; buffer changes its contents before insertion due to calling
+ ;; `expand-file' and alike.
+ (insert
+ (with-current-buffer (tramp-get-buffer v)
+ (buffer-string)))
+
+ ;; Check for "--dired" output.
+ (forward-line -2)
+ (when (looking-at "//SUBDIRED//")
+ (forward-line -1))
+ (when (looking-at "//DIRED//")
+ (let ((end (tramp-compat-line-end-position))
+ (linebeg (point)))
+ ;; Now read the numeric positions of file names.
+ (goto-char linebeg)
+ (forward-word 1)
+ (forward-char 3)
+ (while (< (point) end)
+ (let ((start (+ beg (read (current-buffer))))
+ (end (+ beg (read (current-buffer)))))
+ (if (memq (char-after end) '(?\n ?\ ))
+ ;; End is followed by \n or by " -> ".
+ (put-text-property start end 'dired-filename t))))))
+ ;; Remove trailing lines.
+ (goto-char (tramp-compat-line-beginning-position))
+ (while (looking-at "//")
+ (forward-line 1)
+ (delete-region (match-beginning 0) (point)))
+ (goto-char (point-max))))))
(defun tramp-handle-unhandled-file-name-directory (filename)
"Like `unhandled-file-name-directory' for Tramp files."
(string-match "\\`su\\(do\\)?\\'" method))
(setq uname (concat uname user)))
(setq uname
- (with-connection-property v uname
- (tramp-send-command v (format "cd %s; pwd" uname))
- (with-current-buffer (tramp-get-buffer v)
- (goto-char (point-min))
- (buffer-substring (point) (tramp-compat-line-end-position)))))
+ (with-connection-property v uname
+ (tramp-send-command
+ v (format "cd %s; pwd" (tramp-shell-quote-argument uname)))
+ (with-current-buffer (tramp-get-buffer v)
+ (goto-char (point-min))
+ (buffer-substring
+ (point) (tramp-compat-line-end-position)))))
(setq localname (concat uname fname))))
;; There might be a double slash, for example when "~/"
;; expands to "/". Remove this.
(while (string-match "//" localname)
(setq localname (replace-match "/" t t localname)))
;; No tilde characters in file name, do normal
- ;; expand-file-name (this does "/./" and "/../"). We bind
- ;; `directory-sep-char' here for XEmacs on Windows, which
- ;; would otherwise use backslash. `default-directory' is
- ;; bound, because on Windows there would be problems with UNC
- ;; shares or Cygwin mounts.
+ ;; `expand-file-name' (this does "/./" and "/../"). We bind
+ ;; `directory-sep-char' here for XEmacs on Windows, which would
+ ;; otherwise use backslash. `default-directory' is bound,
+ ;; because on Windows there would be problems with UNC shares or
+ ;; Cygwin mounts.
(let ((directory-sep-char ?/)
(default-directory (tramp-compat-temporary-file-directory)))
(tramp-make-tramp-file-name
"Replace environment variables in FILENAME.
Return the string with the replaced variables."
(save-match-data
- (let ((idx (string-match "$\\w+" filename)))
+ (let ((idx (string-match "$\\(\\w+\\)" filename)))
;; `$' is coded as `$$'.
- (when (and idx (or (zerop idx) (not (eq ?$ (aref filename (1- idx))))))
+ (when (and idx
+ (or (zerop idx) (not (eq ?$ (aref filename (1- idx)))))
+ (getenv (match-string 1 filename)))
(setq filename
(replace-match
(substitute-in-file-name (match-string 0 filename))
;; which calls corresponding functions (see minibuf.el).
(when (fboundp 'minibuffer-electric-separator)
(mapc
- '(lambda (x)
- (eval
- `(defadvice ,x
- (around ,(intern (format "tramp-advice-%s" x)) activate)
- "Invoke `substitute-in-file-name' for Tramp files."
- (if (and (symbol-value 'minibuffer-electric-file-name-behavior)
- (tramp-tramp-file-p (buffer-substring)))
- ;; We don't need to handle `last-input-event', because
- ;; due to the key map we know it must be ?/ or ?~.
- (let ((s (concat (buffer-substring (point-min) (point))
- (string last-command-char))))
- (delete-region (point-min) (point))
- (insert (substitute-in-file-name s))
- (setq ad-return-value last-command-char))
- ad-do-it))))
+ (lambda (x)
+ (eval
+ `(defadvice ,x
+ (around ,(intern (format "tramp-advice-%s" x)) activate)
+ "Invoke `substitute-in-file-name' for Tramp files."
+ (if (and (symbol-value 'minibuffer-electric-file-name-behavior)
+ (tramp-tramp-file-p (buffer-substring)))
+ ;; We don't need to handle `last-input-event', because
+ ;; due to the key map we know it must be ?/ or ?~.
+ (let ((s (concat (buffer-substring (point-min) (point))
+ (string last-command-char))))
+ (delete-region (point-min) (point))
+ (insert (substitute-in-file-name s))
+ (setq ad-return-value last-command-char))
+ ad-do-it)))
+ (eval
+ `(add-hook
+ 'tramp-unload-hook
+ (lambda ()
+ (ad-remove-advice ',x 'around ',(intern (format "tramp-advice-%s" x)))
+ (ad-activate ',x)))))
'(minibuffer-electric-separator
minibuffer-electric-tilde)))
(defun tramp-handle-start-file-process (name buffer program &rest args)
"Like `start-file-process' for Tramp files."
(with-parsed-tramp-file-name default-directory nil
+ (unless (stringp program)
+ (tramp-error
+ v 'file-error "pty association is not supported for `%s'" name))
(unwind-protect
- (let ((name1 name)
+ (let ((command (format "cd %s; exec %s"
+ (tramp-shell-quote-argument localname)
+ (mapconcat 'tramp-shell-quote-argument
+ (cons program args) " ")))
+ (name1 name)
(i 0))
(unless buffer
;; BUFFER can be nil. We use a temporary buffer.
(with-current-buffer (tramp-get-connection-buffer v)
(clear-visited-file-modtime)
(narrow-to-region (point-max) (point-max)))
- ;; Goto working directory. `tramp-send-command' opens a new
+ ;; Send the command. `tramp-send-command' opens a new
;; connection.
- (tramp-send-command
- v (format "cd %s" (tramp-shell-quote-argument localname)))
- ;; Send the command.
- (tramp-send-command
- v
- (format "exec %s"
- (mapconcat 'tramp-shell-quote-argument
- (cons program args) " "))
- nil t) ; nooutput
+ (tramp-send-command v command nil t) ; nooutput
;; Set query flag for this process.
(tramp-set-process-query-on-exit-flag
(tramp-get-connection-process v) t)
(setq outbuf (current-buffer))))
(when stderr (setq command (format "%s 2>%s" command stderr)))
- ;; Goto working directory.
- (tramp-send-command
- v (format "cd %s" (tramp-shell-quote-argument localname)))
;; Send the command. It might not return in time, so we protect it.
(condition-case nil
(unwind-protect
- (tramp-send-command v command)
+ (setq ret
+ (tramp-send-command-and-check
+ v (format "\\cd %s; %s"
+ (tramp-shell-quote-argument localname)
+ command)
+ nil t))
;; We should show the output anyway.
(when outbuf
- (let ((output-string
- (with-current-buffer (tramp-get-connection-buffer v)
- (buffer-substring (point-min) (point-max)))))
- (with-current-buffer outbuf
- (insert output-string)))
+ (with-current-buffer outbuf
+ (insert
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (buffer-string))))
(when display (display-buffer outbuf))))
;; When the user did interrupt, we should do it also. We use
;; return code -1 as marker.
(kill-buffer (tramp-get-connection-buffer v))
(setq ret 1)))
- ;; Check return code.
- (unless ret (setq ret (tramp-send-command-and-check v nil)))
;; Provide error file.
(when tmpstderr (rename-file tmpstderr (cadr destination) t))
+
;; Cleanup. We remove all file cache values for the connection,
;; because the remote process could have changed them.
(when tmpinput (delete-file tmpinput))
- (tramp-flush-directory-property v "")
+
+ ;; `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)
(cond
;; `copy-file' handles direct copy and out-of-band methods.
((or (tramp-local-host-p v)
- (and (tramp-method-out-of-band-p v)
- (> (nth 7 (file-attributes filename))
- tramp-copy-size-limit)))
+ (tramp-method-out-of-band-p
+ v (nth 7 (file-attributes filename))))
(copy-file filename tmpfile t t))
;; Use inline encoding for file transfer.
v 5 "Decoding remote file %s with function %s..."
filename loc-dec)
(funcall loc-dec (point-min) (point-max))
- (let ((coding-system-for-write 'binary))
+ ;; Unset `file-name-handler-alist'. Otherwise,
+ ;; epa-file gets confused.
+ (let (file-name-handler-alist
+ (coding-system-for-write 'binary))
(write-region (point-min) (point-max) tmpfile)))
;; If tramp-decoding-function is not defined for this
;; method, we invoke tramp-decoding-command instead.
(let ((tmpfile2 (tramp-compat-make-temp-file filename)))
- (let ((coding-system-for-write 'binary))
+ ;; Unset `file-name-handler-alist'. Otherwise,
+ ;; epa-file gets confused.
+ (let (file-name-handler-alist
+ (coding-system-for-write 'binary))
(write-region (point-min) (point-max) tmpfile2))
(tramp-message
v 5 "Decoding remote file %s with command %s..."
(defun tramp-handle-file-remote-p (filename &optional identification connected)
"Like `file-remote-p' for Tramp files."
(when (tramp-tramp-file-p filename)
- (with-parsed-tramp-file-name filename nil
- (and (or (not connected)
- (let ((p (tramp-get-connection-process v)))
- (and p (processp p) (memq (process-status p) '(run open)))))
- (cond
- ((eq identification 'method) method)
- ((eq identification 'user) user)
- ((eq identification 'host) host)
- ((eq identification 'localname) localname)
- (t (tramp-make-tramp-file-name method user host "")))))))
+ (let* ((v (tramp-dissect-file-name filename))
+ (p (tramp-get-connection-process v))
+ (c (and p (processp p) (memq (process-status p) '(run open)))))
+ ;; We expand the file name only, if there is already a connection.
+ (with-parsed-tramp-file-name
+ (if c (expand-file-name filename) filename) nil
+ (and (or (not connected) c)
+ (cond
+ ((eq identification 'method) method)
+ ((eq identification 'user) user)
+ ((eq identification 'host) host)
+ ((eq identification 'localname) localname)
+ (t (tramp-make-tramp-file-name method user host ""))))))))
(defun tramp-find-file-name-coding-system-alist (filename tmpname)
"Like `find-operation-coding-system' for Tramp filenames.
"Like `insert-file-contents' for Tramp files."
(barf-if-buffer-read-only)
(setq filename (expand-file-name filename))
- (let (coding-system-used result local-copy)
- (unwind-protect
- (with-parsed-tramp-file-name filename nil
-
+ (let (coding-system-used 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'.
'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))
+ (tramp-send-command
+ v
+ (cond
+ ((and beg end)
+ (format "tail -c +%d %s | head -c +%d >%s"
+ (1+ beg) (tramp-shell-quote-argument localname)
+ (- end beg) remote-copy))
+ (beg
+ (format "tail -c +%d %s >%s"
+ (1+ beg) (tramp-shell-quote-argument localname)
+ remote-copy))
+ (end
+ (format "head -c +%d %s >%s"
+ (1+ 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
(when (eq inhibit-file-name-operation
'insert-file-contents)
'file-local-copy)))
- (file-local-copy filename)))
+ (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 (and (null remote-copy)
+ (tramp-get-method-parameter
+ method 'tramp-copy-keep-tmpfile))
+ ;; We keep the local file for performance reasons,
+ ;; useful for "rsync".
+ (set-file-modes local-copy (tramp-octal-to-decimal "0600"))
+ (setq tramp-temp-buffer-file-name local-copy)
+ (put 'tramp-temp-buffer-file-name 'permanent-local t))
+
(tramp-message
v 4 "Inserting local temp file `%s'..." local-copy)
filename local-copy)))
(setq result
(insert-file-contents
- local-copy nil beg end replace))
+ local-copy nil nil nil replace))
;; Now `last-coding-system-used' has right value.
;; Remember it.
(when (boundp 'last-coding-system-used)
(tramp-message
v 4 "Inserting local temp file `%s'...done" local-copy)
(when (boundp 'last-coding-system-used)
- (set 'last-coding-system-used coding-system-used)))))
+ (set 'last-coding-system-used coding-system-used))))
- ;; 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 (stringp local-copy)
- (delete-file local-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)
(when (boundp 'backup-directory-alist)
(if (symbol-value 'tramp-backup-directory-alist)
(mapcar
- '(lambda (x)
- (cons
- (car x)
- (if (and (stringp (cdr x))
- (file-name-absolute-p (cdr x))
- (not (tramp-file-name-p (cdr x))))
- (tramp-make-tramp-file-name method user host (cdr x))
- (cdr x))))
+ (lambda (x)
+ (cons
+ (car x)
+ (if (and (stringp (cdr x))
+ (file-name-absolute-p (cdr x))
+ (not (tramp-file-name-p (cdr x))))
+ (tramp-make-tramp-file-name method user host (cdr x))
+ (cdr x))))
(symbol-value 'tramp-backup-directory-alist))
(symbol-value 'backup-directory-alist))))
(when (boundp 'bkup-backup-directory-info)
(if (symbol-value 'tramp-bkup-backup-directory-info)
(mapcar
- '(lambda (x)
- (nconc
- (list (car x))
- (list
- (if (and (stringp (car (cdr x)))
- (file-name-absolute-p (car (cdr x)))
- (not (tramp-file-name-p (car (cdr x)))))
- (tramp-make-tramp-file-name
- method user host (car (cdr x)))
- (car (cdr x))))
- (cdr (cdr x))))
+ (lambda (x)
+ (nconc
+ (list (car x))
+ (list
+ (if (and (stringp (car (cdr x)))
+ (file-name-absolute-p (car (cdr x)))
+ (not (tramp-file-name-p (car (cdr x)))))
+ (tramp-make-tramp-file-name
+ method user host (car (cdr x)))
+ (car (cdr x))))
+ (cdr (cdr x))))
(symbol-value 'tramp-bkup-backup-directory-info))
(symbol-value 'bkup-backup-directory-info)))))
;; all other cases we must do it ourselves.
(when (boundp 'auto-save-file-name-transforms)
(mapc
- '(lambda (x)
- (when (and (string-match (car x) buffer-file-name)
- (not (car (cddr x))))
- (setq tramp-auto-save-directory
- (or tramp-auto-save-directory
- (tramp-compat-temporary-file-directory)))))
+ (lambda (x)
+ (when (and (string-match (car x) buffer-file-name)
+ (not (car (cddr x))))
+ (setq tramp-auto-save-directory
+ (or tramp-auto-save-directory
+ (tramp-compat-temporary-file-directory)))))
(symbol-value 'auto-save-file-name-transforms)))
;; Create directory.
(when tramp-auto-save-directory
(defvar tramp-handle-write-region-hook nil
"Normal hook to be run at the end of `tramp-handle-write-region'.")
-;; CCC grok APPEND, LOCKNAME
+;; CCC grok LOCKNAME
(defun tramp-handle-write-region
(start end filename &optional append visit lockname confirm)
"Like `write-region' for Tramp files."
(setq filename (expand-file-name filename))
(with-parsed-tramp-file-name filename nil
- (unless (null append)
- (tramp-error
- v 'file-error "Cannot append to file using Tramp (`%s')" filename))
;; Following part commented out because we don't know what to do about
;; file locking, and it does not appear to be a problem to ignore it.
;; Ange-ftp ignores it, too.
;; needed if we use an encoding function, but currently
;; we use it always because this makes the logic
;; simpler.
- (tmpfile (tramp-compat-make-temp-file filename)))
+ (tmpfile (or tramp-temp-buffer-file-name
+ (tramp-compat-make-temp-file filename))))
+
+ ;; If `append' is non-nil, we copy the file locally, and let
+ ;; the native `write-region' implementation do the job.
+ (when append (copy-file filename tmpfile 'ok))
;; We say `no-message' here because we don't want the
;; visited file modtime data to be clobbered from the temp
'write-region
(list start end tmpfile append 'no-message lockname confirm))
((error quit)
+ (setq tramp-temp-buffer-file-name nil)
(delete-file tmpfile)
(signal (car err) (cdr err))))
(cond
;; `rename-file' handles direct copy and out-of-band methods.
((or (tramp-local-host-p v)
- (and (tramp-method-out-of-band-p v)
- (> (- (or end (point-max)) (or start (point-min)))
- tramp-copy-size-limit)))
- (condition-case err
- (rename-file tmpfile filename t)
- ((error quit)
- (delete-file tmpfile)
- (signal (car err) (cdr err)))))
+ (tramp-method-out-of-band-p
+ v (- (or end (point-max)) (or start (point-min)))))
+ (if (and (= (or end (point-max)) (point-max))
+ (= (or start (point-min)) (point-min))
+ (tramp-get-method-parameter
+ method 'tramp-copy-keep-tmpfile))
+ (progn
+ (setq tramp-temp-buffer-file-name tmpfile)
+ (condition-case err
+ ;; We keep the local file for performance
+ ;; reasons, useful for "rsync".
+ (copy-file tmpfile filename t)
+ ((error quit)
+ (setq tramp-temp-buffer-file-name nil)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err)))))
+ (setq tramp-temp-buffer-file-name nil)
+ ;; Don't rename, in order to keep context in SELinux.
+ (unwind-protect
+ (copy-file tmpfile filename t)
+ (delete-file tmpfile))))
;; Use inline file transfer.
(rem-dec
;; We must protect `last-coding-system-used', now we have set it
;; to its correct value.
- (let (last-coding-system-used)
+ (let (last-coding-system-used (need-chown t))
;; Set file modification time.
(when (or (eq visit t) (stringp visit))
- (set-visited-file-modtime
- ;; We must pass modtime explicitely, because filename can
- ;; be different from (buffer-file-name), f.e. if
- ;; `file-precious-flag' is set.
- (nth 5 (file-attributes filename))))
+ (let ((file-attr (file-attributes filename)))
+ (set-visited-file-modtime
+ ;; We must pass modtime explicitely, because filename can
+ ;; be different from (buffer-file-name), f.e. if
+ ;; `file-precious-flag' is set.
+ (nth 5 file-attr))
+ (when (and (eq (nth 2 file-attr) uid)
+ (eq (nth 3 file-attr) gid))
+ (setq need-chown nil))))
;; Set the ownership.
- (tramp-set-file-uid-gid filename uid gid)
+ (when need-chown
+ (tramp-set-file-uid-gid filename uid gid))
(when (or (eq visit t) (null visit) (stringp visit))
(tramp-message v 0 "Wrote %s" filename))
(run-hooks 'tramp-handle-write-region-hook)))))
+(defvar tramp-vc-registered-file-names nil
+ "List used to collect file names, which are checked during `vc-registered'.")
+
+;; VC backends check for the existence of various different special
+;; files. This is very time consuming, because every single check
+;; requires a remote command (the file cache must be invalidated).
+;; Therefore, we apply a kind of optimization. We install the file
+;; name handler `tramp-vc-file-name-handler', which does nothing but
+;; remembers all file names for which `file-exists-p' or
+;; `file-readable-p' has been applied. A first run of `vc-registered'
+;; is performed. Afterwards, a script is applied for all collected
+;; file names, using just one remote command. The result of this
+;; script is used to fill the file cache with actual values. Now we
+;; can reset the file name handlers, and we make a second run of
+;; `vc-registered', which returns the expected result without sending
+;; any other remote command.
(defun tramp-handle-vc-registered (file)
"Like `vc-registered' for Tramp files."
- ;; There could be new files, created by the vc backend. We disable
- ;; the cache therefore, by providing a temporary one.
- (let ((tramp-cache-data (make-hash-table :test 'equal)))
- (tramp-run-real-handler 'vc-registered (list file))))
+ (with-parsed-tramp-file-name file nil
+
+ ;; There could be new files, created by the vc backend. We cannot
+ ;; reuse the old cache entries, therefore.
+ (let (tramp-vc-registered-file-names
+ (tramp-cache-inhibit-cache (current-time))
+ (file-name-handler-alist
+ `((,tramp-file-name-regexp . tramp-vc-file-name-handler))))
+
+ ;; Here we collect only file names, which need an operation.
+ (tramp-run-real-handler 'vc-registered (list file))
+ (tramp-message v 10 "\n%s" tramp-vc-registered-file-names)
+
+ ;; Send just one command, in order to fill the cache.
+ (when tramp-vc-registered-file-names
+ (tramp-maybe-send-script
+ v
+ (format tramp-vc-registered-read-file-names
+ (tramp-get-file-exists-command v)
+ (format "%s -r" (tramp-get-test-command v)))
+ "tramp_vc_registered_read_file_names")
+
+ (dolist
+ (elt
+ (tramp-send-command-and-read
+ v
+ (format
+ "tramp_vc_registered_read_file_names %s"
+ (mapconcat 'tramp-shell-quote-argument
+ tramp-vc-registered-file-names
+ " "))))
+
+ (tramp-set-file-property v (car elt) (cadr elt) (cadr (cdr elt))))))
+
+ ;; Second run. Now all `file-exists-p' or `file-readable-p' calls
+ ;; shall be answered from the file cache.
+ ;; We unset `process-file-side-effects' in order to keep the cache
+ ;; when `process-file' calls appear.
+ (let (process-file-side-effects)
+ (tramp-run-real-handler 'vc-registered (list file)))))
;;;###autoload
(progn (defun tramp-run-real-handler (operation args)
pass to the OPERATION."
(let* ((inhibit-file-name-handlers
`(tramp-file-name-handler
+ tramp-vc-file-name-handler
tramp-completion-file-name-handler
cygwin-mount-name-hook-function
cygwin-mount-map-drive-hook-function
(list 'add-name-to-file 'copy-file 'expand-file-name
'file-name-all-completions 'file-name-completion
'file-newer-than-file-p 'make-symbolic-link 'rename-file
+ ; Emacs 23 only
+ 'copy-directory
; XEmacs only
'dired-make-relative-symlink
'vm-imap-move-mail 'vm-pop-move-mail 'vm-spool-move-mail))
(tramp-run-real-handler operation args))))))
(setq tramp-locked tl))))
+(defun tramp-vc-file-name-handler (operation &rest args)
+ "Invoke special file name handler, which collects files to be handled."
+ (save-match-data
+ (let ((filename
+ (tramp-replace-environment-variables
+ (apply 'tramp-file-name-for-operation operation args)))
+ (fn (assoc operation tramp-file-name-handler-alist)))
+ (with-parsed-tramp-file-name filename nil
+ (cond
+ ;; That's what we want: file names, for which checks are
+ ;; applied. We assume, that VC uses only `file-exists-p' and
+ ;; `file-readable-p' checks; otherwise we must extend the
+ ;; list. We do not perform any action, but return nil, in
+ ;; order to keep `vc-registered' running.
+ ((and fn (memq operation '(file-exists-p file-readable-p)))
+ (add-to-list 'tramp-vc-registered-file-names localname 'append)
+ nil)
+ ;; Tramp file name handlers like `expand-file-name'. They
+ ;; must still work.
+ (fn
+ (save-match-data (apply (cdr fn) args)))
+ ;; Default file name handlers, we don't care.
+ (t (tramp-run-real-handler operation args)))))))
+
;;;###autoload
(progn (defun tramp-completion-file-name-handler (operation &rest args)
"Invoke Tramp file name completion handler.
;; would otherwise use backslash.
(let ((directory-sep-char ?/)
(fn (assoc operation tramp-completion-file-name-handler-alist)))
- ;; When `tramp-mode' is not enabled, we don't do anything.
- (if (and fn tramp-mode)
+ (if (and
+ ;; When `tramp-mode' is not enabled, we don't do anything.
+ fn tramp-mode
+ ;; For other syntaxes than `sep', the regexp matches many common
+ ;; situations where the user doesn't actually want to use Tramp.
+ ;; So to avoid autoloading Tramp after typing just "/s", we
+ ;; disable this part of the completion, unless the user implicitly
+ ;; indicated his interest in using a fancier completion system.
+ (or (eq tramp-syntax 'sep)
+ (featurep 'tramp) ; If it's loaded, we may as well use it.
+ (and (boundp 'partial-completion-mode) partial-completion-mode)
+ ;; FIXME: These may have been loaded even if the user never
+ ;; intended to use them.
+ (featurep 'ido)
+ (featurep 'icicles)))
(save-match-data (apply (cdr fn) args))
(tramp-completion-run-real-handler operation args)))))
;;;###autoload
-(defsubst tramp-register-file-name-handler ()
- "Add Tramp file name handler to `file-name-handler-alist'."
- ;; Remove autoloaded handler from file name handler alist. Useful,
+(progn (defun tramp-register-file-name-handlers ()
+ "Add Tramp file name handlers to `file-name-handler-alist'."
+ ;; Remove autoloaded handlers from file name handler alist. Useful,
;; if `tramp-syntax' has been changed.
(let ((a1 (rassq 'tramp-file-name-handler file-name-handler-alist)))
- (setq file-name-handler-alist (delete a1 file-name-handler-alist)))
- ;; Add the handler.
+ (setq file-name-handler-alist (delq a1 file-name-handler-alist)))
+ (let ((a1 (rassq
+ 'tramp-completion-file-name-handler file-name-handler-alist)))
+ (setq file-name-handler-alist (delq a1 file-name-handler-alist)))
+ ;; Add the handlers.
(add-to-list 'file-name-handler-alist
(cons tramp-file-name-regexp 'tramp-file-name-handler))
- ;; If jka-compr is already loaded, move it to the front of
- ;; `file-name-handler-alist'.
- (let ((jka (rassoc 'jka-compr-handler file-name-handler-alist)))
- (when jka
- (setq file-name-handler-alist
- (cons jka (delete jka file-name-handler-alist))))))
+ (add-to-list 'file-name-handler-alist
+ (cons tramp-completion-file-name-regexp
+ 'tramp-completion-file-name-handler))
+ (put 'tramp-completion-file-name-handler 'safe-magic t)
+ ;; If jka-compr or epa-file are already loaded, move them to the
+ ;; front of `file-name-handler-alist'.
+ (dolist (fnh '(epa-file-handler jka-compr-handler))
+ (let ((entry (rassoc fnh file-name-handler-alist)))
+ (when entry
+ (setq file-name-handler-alist
+ (cons entry (delete entry file-name-handler-alist))))))))
;; `tramp-file-name-handler' must be registered before evaluation of
;; site-start and init files, because there might exist remote files
;; already, f.e. files kept via recentf-mode.
-;;;###autoload(tramp-register-file-name-handler)
-(tramp-register-file-name-handler)
-
-;;;###autoload
-(defsubst tramp-register-completion-file-name-handler ()
- "Add Tramp completion file name handler to `file-name-handler-alist'."
- ;; Remove autoloaded handler from file name handler alist. Useful,
- ;; if `tramp-syntax' has been changed.
- (let ((a1 (rassq
- 'tramp-completion-file-name-handler file-name-handler-alist)))
- (setq file-name-handler-alist (delete a1 file-name-handler-alist)))
- ;; `partial-completion-mode' is unknown in XEmacs. So we should
- ;; load it unconditionally there. In the GNU Emacs case, method/
- ;; user/host name completion shall be bound to `partial-completion-mode'.
- ;; `ido-mode' and `icy-mode' are other packages which extend file
- ;; name completion.
- (when (or (not (boundp 'partial-completion-mode))
- (symbol-value 'partial-completion-mode)
- (featurep 'ido)
- (featurep 'icicles))
- (add-to-list 'file-name-handler-alist
- (cons tramp-completion-file-name-regexp
- 'tramp-completion-file-name-handler))
- (put 'tramp-completion-file-name-handler 'safe-magic t))
- ;; If jka-compr is already loaded, move it to the front of
- ;; `file-name-handler-alist'.
- (let ((jka (rassoc 'jka-compr-handler file-name-handler-alist)))
- (when jka
- (setq file-name-handler-alist
- (cons jka (delete jka file-name-handler-alist))))))
-
-;; During autoload, it shall be checked whether
-;; `partial-completion-mode' is active. Therefore registering of
-;; `tramp-completion-file-name-handler' will be delayed.
-;;;###autoload(add-hook
-;;;###autoload 'after-init-hook
-;;;###autoload 'tramp-register-completion-file-name-handler)
-(tramp-register-completion-file-name-handler)
+;;;###autoload(tramp-register-file-name-handlers)
+(tramp-register-file-name-handlers)
;;;###autoload
(defun tramp-unload-file-name-handlers ()
(auto-save-mode 1)))
(add-hook 'find-file-hooks 'tramp-set-auto-save t)
(add-hook 'tramp-unload-hook
- '(lambda ()
- (remove-hook 'find-file-hooks 'tramp-set-auto-save)))
+ (lambda ()
+ (remove-hook 'find-file-hooks 'tramp-set-auto-save)))
(defun tramp-run-test (switch filename)
"Run `test' on the remote system, given a SWITCH and a FILENAME.
(format "*tramp/%s %s@%s*" method user host)
(format "*tramp/%s %s*" method host))))
+(defun tramp-delete-temp-file-function ()
+ "Remove temporary files related to current buffer."
+ (when (stringp tramp-temp-buffer-file-name)
+ (condition-case nil
+ (delete-file tramp-temp-buffer-file-name)
+ (error nil))))
+
+(add-hook 'kill-buffer-hook 'tramp-delete-temp-file-function)
+(add-hook 'tramp-cache-unload-hook
+ (lambda ()
+ (remove-hook 'kill-buffer-hook
+ 'tramp-delete-temp-file-function)))
+
(defun tramp-get-buffer (vec)
"Get the connection buffer to be used for VEC."
(or (get-buffer (tramp-buffer-name vec))
(let ((default-directory (tramp-compat-temporary-file-directory)))
(outline-mode))
(set (make-local-variable 'outline-regexp)
- "[0-9]+:[0-9]+:[0-9]+ [a-z0-9-]+ (\\([0-9]+\\)) #")
+ "[0-9]+:[0-9]+:[0-9]+\\.[0-9]+ [a-z0-9-]+ (\\([0-9]+\\)) #")
; (set (make-local-variable 'outline-regexp)
; "[a-z.-]+:[0-9]+: [a-z0-9-]+ (\\([0-9]+\\)) #")
(set (make-local-variable 'outline-level) 'tramp-outline-level))
(when extra-args (setq shell (concat shell " " extra-args))))
(tramp-message
vec 5 "Starting remote shell `%s' for tilde expansion..." shell)
- (let ((tramp-end-of-output "$ "))
+ (let ((tramp-end-of-output tramp-initial-end-of-output))
(tramp-send-command
vec
(format "PROMPT_COMMAND='' PS1=%s PS2='' PS3='' exec %s"
(defun tramp-process-actions (proc vec actions &optional timeout)
"Perform actions until success or TIMEOUT."
- ;; Enable auth-sorce and password-cache.
+ ;; Enable auth-source and password-cache.
(tramp-set-connection-property proc "first-password-request" t)
(let (exit)
(while (not exit)
(delete-region begin (point))
(goto-char (point-min)))))
- (when (not (tramp-get-connection-property proc "check-remote-echo" nil))
+ (when (or (not (tramp-get-connection-property proc "check-remote-echo" nil))
+ ;; Sometimes, the echo string is suppressed on the remote side.
+ (not (string-equal
+ (substring-no-properties
+ tramp-echo-mark-marker
+ 0 (min tramp-echo-mark-marker-length (1- (point-max))))
+ (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.
(goto-char (point-min))
(re-search-forward regexp nil t))))
"Set up an interactive shell.
Mainly sets the prompt and the echo correctly. PROC is the shell
process to set up. VEC specifies the connection."
- (let ((tramp-end-of-output "$ "))
+ (let ((tramp-end-of-output tramp-initial-end-of-output))
;; It is useful to set the prompt in the following command because
;; some people have a setting for $PS1 which /bin/sh doesn't know
;; about and thus /bin/sh will display a strange prompt. For
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 avalible as shell function with the same name.")
+to the remote host, and it is available as shell function with the same name.")
(defun tramp-find-inline-encoding (vec)
"Find an inline transfer encoding that works.
(unless (zerop (tramp-send-command-and-check
vec
(format "echo %s | %s | %s"
- magic rem-enc rem-dec) t))
+ magic rem-enc rem-dec)
+ t))
(throw 'wont-work-remote nil))
(with-current-buffer (tramp-get-buffer vec)
(setenv "TERM" tramp-terminal-type)
(setenv "LC_ALL" "C")
(setenv "PROMPT_COMMAND")
- (setenv "PS1" "$ ")
+ (setenv "PS1" tramp-initial-end-of-output)
(let* ((target-alist (tramp-compute-multi-hops vec))
(process-connection-type tramp-process-connection-type)
(process-adaptive-read-buffering nil)
(?t . ,tmpfile))
command
(concat
+ ;; We do not want to see the trailing local prompt in
+ ;; `start-file-process'.
+ (unless (memq system-type '(windows-nt)) "exec ")
command " "
(mapconcat
- '(lambda (x)
- (setq x (mapcar '(lambda (y) (format-spec y spec)) x))
- (unless (member "" x) (mapconcat 'identity x " ")))
+ (lambda (x)
+ (setq x (mapcar (lambda (y) (format-spec y spec)) x))
+ (unless (member "" x) (mapconcat 'identity x " ")))
login-args " ")
;; Local shell could be a Windows COMSPEC. It doesn't
;; know the ";" syntax, but we must exit always for
;; `start-file-process'. "exec" does not work either.
- " && exit || exit"))
+ (if (memq system-type '(windows-nt)) " && exit || exit")))
;; Send the command.
(tramp-message vec 3 "Sending command `%s'" command)
(defun tramp-wait-for-output (proc &optional timeout)
"Wait for output from remote rsh command."
(with-current-buffer (process-buffer proc)
- (let* (;; Initially, `tramp-end-of-output' is "$ ". There might
+ (let* (;; Initially, `tramp-end-of-output' is "#$ ". There might
;; be leading escape sequences, which must be ignored.
- (regexp (format "[^$\n]*%s\r?$" (regexp-quote tramp-end-of-output)))
+ (regexp (format "[^#$\n]*%s\r?$" (regexp-quote tramp-end-of-output)))
;; Sometimes, the commands do not return a newline but a
;; null byte before the shell prompt, for example "git
;; ls-files -c -z ...".
;; Return value is whether end-of-output sentinel was found.
found)))
-(defun tramp-send-command-and-check (vec command &optional subshell)
+(defun tramp-send-command-and-check
+ (vec command &optional subshell dont-suppress-err)
"Run COMMAND and check its exit status.
Sends `echo $?' along with the COMMAND for checking the exit status. If
COMMAND is nil, just sends `echo $?'. Returns the exit status found.
-If the optional argument SUBSHELL is non-nil, the command is executed in
-a subshell, ie surrounded by parentheses."
+If the optional argument SUBSHELL is non-nil, the command is
+executed in a subshell, ie surrounded by parentheses. If
+DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to /dev/null."
(tramp-send-command
vec
(concat (if subshell "( " "")
command
- (if command " 2>/dev/null; " "")
+ (if command (if dont-suppress-err "; " " 2>/dev/null; ") "")
"echo tramp_exit_status $?"
- (if subshell " )" " ")))
+ (if subshell " )" "")))
(with-current-buffer (tramp-get-connection-buffer vec)
(goto-char (point-max))
(unless (re-search-backward "tramp_exit_status [0-9]+" nil t)
"Convert file-attributes ATTR generated by perl script, stat or ls.
Convert file mode bits to string and set virtual device number.
Return ATTR."
- ;; Convert last access time.
- (unless (listp (nth 4 attr))
- (setcar (nthcdr 4 attr)
- (list (floor (nth 4 attr) 65536)
- (floor (mod (nth 4 attr) 65536)))))
- ;; Convert last modification time.
- (unless (listp (nth 5 attr))
- (setcar (nthcdr 5 attr)
- (list (floor (nth 5 attr) 65536)
- (floor (mod (nth 5 attr) 65536)))))
- ;; Convert last status change time.
- (unless (listp (nth 6 attr))
- (setcar (nthcdr 6 attr)
- (list (floor (nth 6 attr) 65536)
- (floor (mod (nth 6 attr) 65536)))))
- ;; Convert file size.
- (when (< (nth 7 attr) 0)
- (setcar (nthcdr 7 attr) -1))
- (when (and (floatp (nth 7 attr))
- (<= (nth 7 attr) (tramp-compat-most-positive-fixnum)))
- (setcar (nthcdr 7 attr) (round (nth 7 attr))))
- ;; Convert file mode bits to string.
- (unless (stringp (nth 8 attr))
- (setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr)))
- (when (stringp (car attr))
- (aset (nth 8 attr) 0 ?l)))
- ;; Convert directory indication bit.
- (when (string-match "^d" (nth 8 attr))
- (setcar attr t))
- ;; Convert symlink from `tramp-handle-file-attributes-with-stat'.
- (when (consp (car attr))
- (if (and (stringp (caar attr))
- (string-match ".+ -> .\\(.+\\)." (caar attr)))
- (setcar attr (match-string 1 (caar attr)))
- (setcar attr nil)))
- ;; Set file's gid change bit.
- (setcar (nthcdr 9 attr)
- (if (numberp (nth 3 attr))
- (not (= (nth 3 attr)
- (tramp-get-remote-gid vec 'integer)))
- (not (string-equal
- (nth 3 attr)
- (tramp-get-remote-gid vec 'string)))))
- ;; Convert inode.
- (unless (listp (nth 10 attr))
- (setcar (nthcdr 10 attr)
- (condition-case nil
- (cons (floor (nth 10 attr) 65536)
- (floor (mod (nth 10 attr) 65536)))
- ;; Inodes can be incredible huge. We must hide this.
- (error (tramp-get-inode vec)))))
- ;; Set virtual device number.
- (setcar (nthcdr 11 attr)
- (tramp-get-device vec))
- attr)
+ (when attr
+ ;; Convert last access time.
+ (unless (listp (nth 4 attr))
+ (setcar (nthcdr 4 attr)
+ (list (floor (nth 4 attr) 65536)
+ (floor (mod (nth 4 attr) 65536)))))
+ ;; Convert last modification time.
+ (unless (listp (nth 5 attr))
+ (setcar (nthcdr 5 attr)
+ (list (floor (nth 5 attr) 65536)
+ (floor (mod (nth 5 attr) 65536)))))
+ ;; Convert last status change time.
+ (unless (listp (nth 6 attr))
+ (setcar (nthcdr 6 attr)
+ (list (floor (nth 6 attr) 65536)
+ (floor (mod (nth 6 attr) 65536)))))
+ ;; Convert file size.
+ (when (< (nth 7 attr) 0)
+ (setcar (nthcdr 7 attr) -1))
+ (when (and (floatp (nth 7 attr))
+ (<= (nth 7 attr) (tramp-compat-most-positive-fixnum)))
+ (setcar (nthcdr 7 attr) (round (nth 7 attr))))
+ ;; Convert file mode bits to string.
+ (unless (stringp (nth 8 attr))
+ (setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr)))
+ (when (stringp (car attr))
+ (aset (nth 8 attr) 0 ?l)))
+ ;; Convert directory indication bit.
+ (when (string-match "^d" (nth 8 attr))
+ (setcar attr t))
+ ;; Convert symlink from `tramp-do-file-attributes-with-stat'.
+ (when (consp (car attr))
+ (if (and (stringp (caar attr))
+ (string-match ".+ -> .\\(.+\\)." (caar attr)))
+ (setcar attr (match-string 1 (caar attr)))
+ (setcar attr nil)))
+ ;; Set file's gid change bit.
+ (setcar (nthcdr 9 attr)
+ (if (numberp (nth 3 attr))
+ (not (= (nth 3 attr)
+ (tramp-get-remote-gid vec 'integer)))
+ (not (string-equal
+ (nth 3 attr)
+ (tramp-get-remote-gid vec 'string)))))
+ ;; Convert inode.
+ (unless (listp (nth 10 attr))
+ (setcar (nthcdr 10 attr)
+ (condition-case nil
+ (cons (floor (nth 10 attr) 65536)
+ (floor (mod (nth 10 attr) 65536)))
+ ;; Inodes can be incredible huge. We must hide this.
+ (error (tramp-get-inode vec)))))
+ ;; Set virtual device number.
+ (setcar (nthcdr 11 attr)
+ (tramp-get-device vec))
+ attr))
+
+(defun tramp-check-cached-permissions (vec access)
+ "Check `file-attributes' caches for VEC.
+Return t if according to the cache access type ACCESS is known to
+be granted."
+ (let ((result nil)
+ (offset (cond
+ ((eq ?r access) 1)
+ ((eq ?w access) 2)
+ ((eq ?x access) 3))))
+ (dolist (suffix '("string" "integer") result)
+ (setq
+ result
+ (or
+ result
+ (let ((file-attr
+ (tramp-get-file-property
+ vec (tramp-file-name-localname vec)
+ (concat "file-attributes-" suffix) nil))
+ (remote-uid
+ (tramp-get-connection-property
+ vec (concat "uid-" suffix) nil))
+ (remote-gid
+ (tramp-get-connection-property
+ vec (concat "gid-" suffix) nil)))
+ (and
+ file-attr
+ (or
+ ;; Not a symlink
+ (eq t (car file-attr))
+ (null (car file-attr)))
+ (or
+ ;; World accessible.
+ (eq access (aref (nth 8 file-attr) (+ offset 6)))
+ ;; User accessible and owned by user.
+ (and
+ (eq access (aref (nth 8 file-attr) offset))
+ (equal remote-uid (nth 2 file-attr)))
+ ;; Group accessible and owned by user's
+ ;; principal group.
+ (and
+ (eq access (aref (nth 8 file-attr) (+ offset 3)))
+ (equal remote-gid (nth 3 file-attr)))))))))))
(defun tramp-get-inode (vec)
"Returns the virtual inode number.
;; "user%domain". Sometimes, we must extract these parts.
(defun tramp-file-name-real-user (vec)
"Return the user name of VEC without domain."
- (let ((user (tramp-file-name-user vec)))
- (if (and (stringp user)
- (string-match tramp-user-with-domain-regexp user))
- (match-string 1 user)
- user)))
+ (save-match-data
+ (let ((user (tramp-file-name-user vec)))
+ (if (and (stringp user)
+ (string-match tramp-user-with-domain-regexp user))
+ (match-string 1 user)
+ user))))
(defun tramp-file-name-domain (vec)
"Return the domain name of VEC."
- (let ((user (tramp-file-name-user vec)))
- (and (stringp user)
- (string-match tramp-user-with-domain-regexp user)
- (match-string 2 user))))
+ (save-match-data
+ (let ((user (tramp-file-name-user vec)))
+ (and (stringp user)
+ (string-match tramp-user-with-domain-regexp user)
+ (match-string 2 user)))))
;; The host part of a Tramp file name vector can be of kind
;; "host#port". Sometimes, we must extract these parts.
(defun tramp-file-name-real-host (vec)
"Return the host name of VEC without port."
- (let ((host (tramp-file-name-host vec)))
- (if (and (stringp host)
- (string-match tramp-host-with-port-regexp host))
- (match-string 1 host)
- host)))
+ (save-match-data
+ (let ((host (tramp-file-name-host vec)))
+ (if (and (stringp host)
+ (string-match tramp-host-with-port-regexp host))
+ (match-string 1 host)
+ host))))
(defun tramp-file-name-port (vec)
"Return the port number of VEC."
- (let ((host (tramp-file-name-host vec)))
- (and (stringp host)
- (string-match tramp-host-with-port-regexp host)
- (string-to-number (match-string 2 host)))))
+ (save-match-data
+ (let ((host (tramp-file-name-host vec)))
+ (and (stringp host)
+ (string-match tramp-host-with-port-regexp host)
+ (string-to-number (match-string 2 host))))))
(defun tramp-tramp-file-p (name)
- "Return t if NAME is a Tramp file."
+ "Return t if NAME is a string with Tramp file name syntax."
(save-match-data
- (string-match tramp-file-name-regexp name)))
+ (and (stringp name) (string-match tramp-file-name-regexp name))))
(defun tramp-find-method (method user host)
"Return the right method string to use.
(format "%s@%s:%s" user host localname)
(format "%s:%s" host localname))))
-(defun tramp-method-out-of-band-p (vec)
+(defun tramp-method-out-of-band-p (vec size)
"Return t if this is an out-of-band method, nil otherwise."
- (tramp-get-method-parameter (tramp-file-name-method vec) 'tramp-copy-program))
+ (and
+ ;; It shall be an out-of-band method.
+ (tramp-get-method-parameter (tramp-file-name-method vec) 'tramp-copy-program)
+ ;; Either the file size is large enough, or (in rare cases) there
+ ;; does not exist a remote encoding.
+ (or (> size tramp-copy-size-limit)
+ (null (tramp-get-remote-coding vec "remote-encoding")))))
(defun tramp-local-host-p (vec)
"Return t if this points to the local host, nil otherwise."
(and
(stringp host)
(string-match tramp-local-host-regexp host)
+ ;; The method shall be applied to one of the shell file name
+ ;; handler. `tramp-local-host-p' is also called for "smb" and
+ ;; alike, where it must fail.
+ (tramp-get-method-parameter
+ (tramp-file-name-method vec) 'tramp-login-program)
;; The local temp directory must be writable for the other user.
(file-writable-p
(tramp-make-tramp-file-name
(defun tramp-get-ls-command (vec)
(with-connection-property vec "ls"
- (with-current-buffer (tramp-get-buffer vec)
- (tramp-message vec 5 "Finding a suitable `ls' command")
- (or
- (catch 'ls-found
- (dolist (cmd '("ls" "gnuls" "gls"))
- (let ((dl (tramp-get-remote-path vec))
- result)
- (while
- (and
- dl
- (setq result
- (tramp-find-executable vec cmd dl t t)))
- ;; Check parameter.
- (when (zerop (tramp-send-command-and-check
- vec (format "%s -lnd /" result)))
- (throw 'ls-found result))
- (setq dl (cdr dl))))))
- (tramp-error vec 'file-error "Couldn't find a proper `ls' command")))))
+ (tramp-message vec 5 "Finding a suitable `ls' command")
+ (or
+ (catch 'ls-found
+ (dolist (cmd '("ls" "gnuls" "gls"))
+ (let ((dl (tramp-get-remote-path vec))
+ result)
+ (while (and dl (setq result (tramp-find-executable vec cmd dl t t)))
+ ;; Check parameter.
+ (when (zerop (tramp-send-command-and-check
+ vec (format "%s -lnd /" result)))
+ (throw 'ls-found result))
+ (setq dl (cdr dl))))))
+ (tramp-error vec 'file-error "Couldn't find a proper `ls' command"))))
+
+(defun tramp-get-ls-command-with-dired (vec)
+ (save-match-data
+ (with-connection-property vec "ls-dired"
+ (tramp-message vec 5 "Checking, whether `ls --dired' works")
+ (zerop (tramp-send-command-and-check
+ vec (format "%s --dired /" (tramp-get-ls-command vec)))))))
(defun tramp-get-test-command (vec)
(with-connection-property vec "test"
- (with-current-buffer (tramp-get-buffer vec)
- (tramp-message vec 5 "Finding a suitable `test' command")
- (if (zerop (tramp-send-command-and-check vec "test 0"))
- "test"
- (tramp-find-executable vec "test" (tramp-get-remote-path vec))))))
+ (tramp-message vec 5 "Finding a suitable `test' command")
+ (if (zerop (tramp-send-command-and-check vec "test 0"))
+ "test"
+ (tramp-find-executable vec "test" (tramp-get-remote-path vec)))))
(defun tramp-get-test-nt-command (vec)
;; Does `test A -nt B' work? Use abominable `find' construct if it
(defun tramp-get-file-exists-command (vec)
(with-connection-property vec "file-exists"
- (with-current-buffer (tramp-get-buffer vec)
- (tramp-message vec 5 "Finding command to check if file exists")
- (tramp-find-file-exists-command vec))))
+ (tramp-message vec 5 "Finding command to check if file exists")
+ (tramp-find-file-exists-command vec)))
(defun tramp-get-remote-ln (vec)
(with-connection-property vec "ln"
- (with-current-buffer (tramp-get-buffer vec)
- (tramp-message vec 5 "Finding a suitable `ln' command")
- (tramp-find-executable vec "ln" (tramp-get-remote-path vec)))))
+ (tramp-message vec 5 "Finding a suitable `ln' command")
+ (tramp-find-executable vec "ln" (tramp-get-remote-path vec))))
(defun tramp-get-remote-perl (vec)
(with-connection-property vec "perl"
- (with-current-buffer (tramp-get-buffer vec)
- (tramp-message vec 5 "Finding a suitable `perl' command")
- (or (tramp-find-executable vec "perl5" (tramp-get-remote-path vec))
- (tramp-find-executable vec "perl" (tramp-get-remote-path vec))))))
+ (tramp-message vec 5 "Finding a suitable `perl' command")
+ (let ((result
+ (or (tramp-find-executable vec "perl5" (tramp-get-remote-path vec))
+ (tramp-find-executable
+ vec "perl" (tramp-get-remote-path vec)))))
+ ;; We must check also for some Perl modules.
+ (when result
+ (with-connection-property vec "perl-file-spec"
+ (zerop
+ (tramp-send-command-and-check
+ vec (format "%s -e 'use File::Spec;'" result))))
+ (with-connection-property vec "perl-cwd-realpath"
+ (zerop
+ (tramp-send-command-and-check
+ vec (format "%s -e 'use Cwd \"realpath\";'" result)))))
+ result)))
(defun tramp-get-remote-stat (vec)
(with-connection-property vec "stat"
- (with-current-buffer (tramp-get-buffer vec)
- (tramp-message vec 5 "Finding a suitable `stat' command")
- (let ((result (tramp-find-executable
- vec "stat" (tramp-get-remote-path vec)))
- tmp)
- ;; Check whether stat(1) returns usable syntax. %s does not
- ;; work on older AIX systems.
- (when result
- (setq tmp
- ;; We don't want to display an error message.
- (with-temp-message (or (current-message) "")
- (condition-case nil
- (tramp-send-command-and-read
- vec (format "%s -c '(\"%%N\" %%s)' /" result))
- (error nil))))
- (unless (and (listp tmp) (stringp (car tmp))
- (string-match "^./.$" (car tmp))
- (integerp (cadr tmp)))
- (setq result nil)))
+ (tramp-message vec 5 "Finding a suitable `stat' command")
+ (let ((result (tramp-find-executable
+ vec "stat" (tramp-get-remote-path vec)))
+ tmp)
+ ;; Check whether stat(1) returns usable syntax. %s does not
+ ;; work on older AIX systems.
+ (when result
+ (setq tmp
+ ;; We don't want to display an error message.
+ (with-temp-message (or (current-message) "")
+ (condition-case nil
+ (tramp-send-command-and-read
+ vec (format "%s -c '(\"%%N\" %%s)' /" result))
+ (error nil))))
+ (unless (and (listp tmp) (stringp (car tmp))
+ (string-match "^./.$" (car tmp))
+ (integerp (cadr tmp)))
+ (setq result nil)))
+ result)))
+
+(defun tramp-get-remote-readlink (vec)
+ (with-connection-property vec "readlink"
+ (tramp-message vec 5 "Finding a suitable `readlink' command")
+ (let ((result (tramp-find-executable
+ vec "readlink" (tramp-get-remote-path vec))))
+ (when (and result
+ ;; We don't want to display an error message.
+ (with-temp-message (or (current-message) "")
+ (condition-case nil
+ (zerop
+ (tramp-send-command-and-check
+ vec (format "%s --canonicalize-missing /" result)))
+ (error nil))))
result))))
(defun tramp-get-remote-id (vec)
(with-connection-property vec "id"
- (with-current-buffer (tramp-get-buffer vec)
- (tramp-message vec 5 "Finding POSIX `id' command")
- (or
- (catch 'id-found
- (let ((dl (tramp-get-remote-path vec))
- result)
- (while
- (and
- dl
- (setq result
- (tramp-find-executable vec "id" dl t t)))
- ;; Check POSIX parameter.
- (when (zerop (tramp-send-command-and-check
- vec (format "%s -u" result)))
- (throw 'id-found result))
- (setq dl (cdr dl)))))
- (tramp-error vec 'file-error "Couldn't find a POSIX `id' command")))))
+ (tramp-message vec 5 "Finding POSIX `id' command")
+ (or
+ (catch 'id-found
+ (let ((dl (tramp-get-remote-path vec))
+ result)
+ (while (and dl (setq result (tramp-find-executable vec "id" dl t t)))
+ ;; Check POSIX parameter.
+ (when (zerop (tramp-send-command-and-check
+ vec (format "%s -u" result)))
+ (throw 'id-found result))
+ (setq dl (cdr dl)))))
+ (tramp-error vec 'file-error "Couldn't find a POSIX `id' command"))))
(defun tramp-get-remote-uid (vec id-format)
(with-connection-property vec (format "uid-%s" id-format)
(file-name-handler-alist
(list
(cons "/"
- '(lambda (operation &rest args)
- "Returns OPERATION if it is the one to be checked."
- (if (equal check-file-name-operation operation)
- operation
- (let ((file-name-handler-alist fnha))
- (apply operation args))))))))
+ (lambda (operation &rest args)
+ "Returns OPERATION if it is the one to be checked."
+ (if (equal check-file-name-operation operation)
+ operation
+ (let ((file-name-handler-alist fnha))
+ (apply operation args))))))))
(equal (apply operation args) operation))
(error nil)))
(around tramp-advice-make-auto-save-file-name () activate)
"Invoke `tramp-handle-make-auto-save-file-name' for Tramp files."
(if (and (buffer-file-name) (tramp-tramp-file-p (buffer-file-name)))
- (setq ad-return-value (tramp-handle-make-auto-save-file-name))
+ ;; We cannot call `tramp-handle-make-auto-save-file-name'
+ ;; directly, because this would bypass the locking mechanism.
+ (setq ad-return-value
+ (tramp-file-name-handler 'make-auto-save-file-name))
ad-do-it))
- (add-hook 'tramp-unload-hook
- '(lambda () (ad-unadvise 'make-auto-save-file-name))))
+ (add-hook
+ 'tramp-unload-hook
+ (lambda ()
+ (ad-remove-advice
+ 'make-auto-save-file-name
+ 'around 'tramp-advice-make-auto-save-file-name)
+ (ad-activate 'make-auto-save-file-name))))
;; In Emacs < 22 and XEmacs < 21.5 autosaved remote files have
;; permission 0666 minus umask. This is a security threat.
(> emacs-minor-version 4)))
(add-hook 'auto-save-hook 'tramp-set-auto-save-file-modes)
(add-hook 'tramp-unload-hook
- '(lambda ()
- (remove-hook 'auto-save-hook 'tramp-set-auto-save-file-modes))))
+ (lambda ()
+ (remove-hook 'auto-save-hook 'tramp-set-auto-save-file-modes))))
(defun tramp-subst-strs-in-string (alist string)
"Replace all occurrences of the string FROM with TO in STRING.
t t result)))
result))))
-;; We currently (sometimes) use "[" and "]" in the filename format.
-;; This means that Emacs wants to expand wildcards if
-;; `find-file-wildcards' is non-nil, and then barfs because no
-;; expansion could be found. We detect this situation and do
-;; something really awful: we have `file-expand-wildcards' return the
-;; original filename if it can't expand anything. Let's just hope
-;; that this doesn't break anything else.
-;; CCC: This check is now also really awful; we should search all
-;; of the filename format, not just the prefix.
-(when (string-match "\\[" tramp-prefix-format)
- (defadvice file-expand-wildcards
- (around tramp-advice-file-expand-wildcards activate)
- (let ((name (ad-get-arg 0)))
- (if (tramp-tramp-file-p name)
- ;; If it's a Tramp file, dissect it and look if wildcards
- ;; need to be expanded at all.
- (if (string-match
- "[[*?]"
- (tramp-file-name-localname (tramp-dissect-file-name name)))
- (setq ad-return-value (or ad-do-it (list name)))
- (setq ad-return-value (list name)))
- ;; If it is not a Tramp file, just run the original function.
- (setq ad-return-value (or ad-do-it (list name))))))
- (add-hook 'tramp-unload-hook
- '(lambda () (ad-unadvise 'file-expand-wildcards))))
-
;; Checklist for `tramp-unload-hook'
;; - Unload all `tramp-*' packages
;; - Reset `file-name-handler-alist'
;; within Tramp around one of its calls to accept-process-output (or
;; around one of the loops that calls accept-process-output)
;; (Stefan Monnier).
-;; * Autodetect if remote `ls' groks the "--dired" switch.
;; * Rewrite `tramp-shell-quote-argument' to abstain from using
;; `shell-quote-argument'.
;; * In Emacs 21, `insert-directory' shows total number of bytes used
;; * `vc-directory' does not work. It never displays any files, even
;; if it does show files when run locally.
;; * How to deal with MULE in `insert-file-contents' and `write-region'?
-;; * Grok `append' parameter for `write-region'.
;; * Test remote ksh or bash for tilde expansion in `tramp-find-shell'?
;; * abbreviate-file-name
-;; * better error checking. At least whenever we see something
+;; * Better error checking. At least whenever we see something
;; strange when doing zerop, we should kill the process and start
;; again. (Greg Stark)
-;; * Provide a local cache of old versions of remote files for the rsync
-;; transfer method to use. (Greg Stark)
;; * Remove unneeded parameters from methods.
-;; * Invoke rsync once for copying a whole directory hierarchy.
-;; (Francesco Potortì)
;; * Make it work for different encodings, and for different file name
;; encodings, too. (Daniel Pittman)
;; * Progress reports while copying files. (Michael Kifer)
;; reasonably unproblematic. And maybe trampclient should have some
;; way of passing credentials, like by using an SSL socket or
;; something. (David Kastrup)
-;; * Could Tramp reasonably look for a prompt after ^M rather than
-;; only after ^J ? (Stefan Monnier)
;; * Reconnect directly to a compliant shell without first going
;; through the user's default shell. (Pete Forman)
;; * Make `tramp-default-user' obsolete.
;; SSH instance, would correctly be propagated to the remote process
;; automatically; possibly SSH would have to be started with
;; "-t". (Markus Triska)
-;; * Set `tramp-copy-size-limit' to 0, when there is no remote
-;; encoding routine.
;; * It makes me wonder if tramp couldn't fall back to ssh when scp
;; isn't on the remote host. (Mark A. Hershberger)
-;; * To improve the behavior in case of things like "git status", it
-;; might be worthwhile to add some way to indicate that a particular
-;; use of process-file is (supposed to be) free of side-effects.
-;; (Stefan Monnier)
;; * Use lsh instead of ssh. (Alfred M. Szmidt)
;; * Implement a general server-local-variable mechanism, as there are
;; probably other variables that need different values for different
;; tramp-server-local-variable-alist) to define any such variables
;; that they need to, which would then be let bound as appropriate
;; in tramp functions. (Jason Rumney)
+;; * Optimize out-of-band copying, when both methods are scp-like (not
+;; rsync).
+;; * Keep a second connection open for out-of-band methods like scp or
+;; rsync.
+;; * Support ptys in `tramp-handle-start-file-process'.
;; Functions for file-name-handler-alist:
;; diff-latest-backup-file -- in diff.el
HCoop / bpt / emacs.git / blobdiff