;;; 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.
;;
: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-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)
(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.")
(defcustom tramp-shell-prompt-pattern
;; 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] *\\)*"
+ "\\(?:^\\|\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)
;;; 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-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;
'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:
(defun tramp-handle-make-symbolic-link
;; 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
"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)))
"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
;; When DIRNAME and NEWNAME are remote, they must have
;; the same method.
(or (null t1) (null t2)
- (string-equal (file-remote-p dirname 'method)
- (file-remote-p newname 'method))))
+ (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))
(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."
(tramp-error
v 'file-error "Cannot find copy program: %s" copy-program))
+ ;; 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))
+
(unwind-protect
(with-temp-buffer
;; The default directory must be remote.
;; 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)
(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
;; 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)))
(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)))))
+ (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.
(delete-region (point-min) (point))
(insert (substitute-in-file-name s))
(setq ad-return-value last-command-char))
- ad-do-it))))
+ 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)))
(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))
(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.
;; Write region into a tmp file. This isn't really
;; needed if we use an encoding function, but currently
;; we use it always because this makes the logic
- ;; simpler. If `append' is non-nil, we copy the file
- ;; locally, and let the native `write-region'
- ;; implementation do the job.
- (tmpfile (if append
- (file-local-copy filename)
- (or tramp-temp-buffer-file-name
- (tramp-compat-make-temp-file filename)))))
+ ;; simpler.
+ (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
((or (tramp-local-host-p v)
(tramp-method-out-of-band-p
v (- (or end (point-max)) (or start (point-min)))))
- (condition-case err
- (if (and (= (or end (point-max)) (point-max))
- (= (or start (point-min)) (point-min))
- (tramp-get-method-parameter
- method 'tramp-copy-keep-tmpfile))
- (progn
+ (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".
- (setq tramp-temp-buffer-file-name tmpfile)
- (copy-file tmpfile filename t))
- (setq tramp-temp-buffer-file-name nil)
- (rename-file tmpfile filename t))
- ((error quit)
- (setq tramp-temp-buffer-file-name nil)
- (delete-file tmpfile)
- (signal (car err) (cdr err)))))
+ (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)))))
(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"
(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
(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)
;; 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)
(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.
If it doesn't exist, generate a new one."
(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.
(defun tramp-get-remote-perl (vec)
(with-connection-property vec "perl"
(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)))))
+ (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"
(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"
(tramp-message vec 5 "Finding POSIX `id' command")
(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.
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'