Commit 293c24f9 authored by Michael Albinus's avatar Michael Albinus
Browse files

* net/tramp.el (tramp-perl-file-truename): New defconst. Perl

code contributed by yary <not.com@gmail.com> (tiny change).
(tramp-handle-file-truename, tramp-get-remote-perl): Use it.
Check also for "perl-file-spec" and "perl-cwd-realpath"
properties.
(tramp-handle-write-region): In case of APPEND, reuse the tmpfile
name.

* net/tramp.el (tramp-perl-file-name-all-completions): New
defconst.
(tramp-get-remote-readlink): New defun.
(tramp-handle-file-truename): Use it.
(tramp-handle-file-exists-p): Check file-attributes cache, assume
file exists if cache value present.
(tramp-check-cached-permissions) New defun.
(tramp-handle-file-readable-p): Use it.
(tramp-handle-file-writable-p): Likewise.
(tramp-handle-file-executable-p): Likewise.
(tramp-handle-file-name-all-completions): Try using Perl to get
partial completions.  When perl not available, combine `cd' and
`ls' into single remote operation and use shell expansion to get
partial remote directory contents.  Set `file-exists-p' cache for
directory and any files returned by ls.  Change cache handling to
support partial directory contents.  Use error message emitted by
remote `cd' or Perl code for local tramp-error.
(tramp-do-copy-or-rename-file-directly): Avoid separate
tramp-send-command-and-check call.
(tramp-handle-process-file): Merge three remote ops into one.  Do
not flush all caches when `process-file-side-effects' is set.
(tramp-handle-write-region): Avoid tramp-set-file-uid-gid if
file-attributes shows uid/gid to be set already.
parent 36f1267e
2009-10-26 Michael Albinus <michael.albinus@gmx.de>
* net/tramp.el (tramp-perl-file-truename): New defconst. Perl
code contributed by yary <not.com@gmail.com> (tiny change).
(tramp-handle-file-truename, tramp-get-remote-perl): Use it.
Check also for "perl-file-spec" and "perl-cwd-realpath"
properties.
(tramp-handle-write-region): In case of APPEND, reuse the tmpfile
name.
* net/tramp-imap.el (tramp-imap-file-name-handler-alist): Ignore
`dired-call-process'.
(tramp-imap-make-iht): Use `user' and `ssl' with `imap-hash-make'.
2009-10-26 Julian Scheid <julians37@gmail.com>
* net/tramp.el (tramp-perl-file-name-all-completions): New
defconst.
(tramp-get-remote-readlink): New defun.
(tramp-handle-file-truename): Use it.
(tramp-handle-file-exists-p): Check file-attributes cache, assume
file exists if cache value present.
(tramp-check-cached-permissions) New defun.
(tramp-handle-file-readable-p): Use it.
(tramp-handle-file-writable-p): Likewise.
(tramp-handle-file-executable-p): Likewise.
(tramp-handle-file-name-all-completions): Try using Perl to get
partial completions. When perl not available, combine `cd' and
`ls' into single remote operation and use shell expansion to get
partial remote directory contents. Set `file-exists-p' cache for
directory and any files returned by ls. Change cache handling to
support partial directory contents. Use error message emitted by
remote `cd' or Perl code for local tramp-error.
(tramp-do-copy-or-rename-file-directly): Avoid separate
tramp-send-command-and-check call.
(tramp-handle-process-file): Merge three remote ops into one. Do
not flush all caches when `process-file-side-effects' is set.
(tramp-handle-write-region): Avoid tramp-set-file-uid-gid if
file-attributes shows uid/gid to be set already.
2009-10-26 Dan Nicolaescu <dann@ics.uci.edu>
* textmodes/tex-mode.el (tex-dvi-view-command)
......
......@@ -1613,6 +1613,75 @@ Many systems support `uudecode -o /dev/stdout' or `uudecode -o -'
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
......@@ -2430,78 +2499,105 @@ target of the symlink differ."
"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.
......@@ -2509,12 +2605,16 @@ target of the symlink differ."
"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
......@@ -2843,13 +2943,19 @@ and gid of the corresponding user is taken. Both parameters must be integers."
"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
......@@ -2939,8 +3045,10 @@ value of `default-file-modes', without execute permissions."
(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)))
......@@ -3074,50 +3182,149 @@ value of `default-file-modes', without execute permissions."
"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
......@@ -3380,16 +3587,18 @@ the uid and gid from FILENAME."
(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
......@@ -3398,7 +3607,7 @@ the uid and gid from FILENAME."
;; 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."
......@@ -4128,20 +4337,20 @@ beginning of local filename are not substituted."
(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)))
;; 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.
......@@ -4153,8 +4362,6 @@ beginning of local filename are not substituted."
(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))
......@@ -4672,13 +4879,13 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
;; 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
......@@ -4836,17 +5043,22 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
;; 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))