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,21 +2499,46 @@ 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
(let ((result nil)) ; result steps in reverse order
(tramp-message v 4 "Finding true name for `%s'" filename)
(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.
;; 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)
(tramp-message v 4 "Finding true name for `%s'" filename)
(while (and steps (< numchase numchase-limit))
(setq thisstep (pop steps))
(tramp-message
......@@ -2482,7 +2576,8 @@ target of the symlink differ."
"Symlink target `%s' on wrong host" symlink-target))
(setq symlink-target localname))
(setq steps
(append (tramp-compat-split-string symlink-target "/")
(append (tramp-compat-split-string
symlink-target "/")
steps)))
(t
;; It's a file.
......@@ -2499,7 +2594,8 @@ target of the symlink differ."
"/"))
(when (and is-dir (or (string= "" result)
(not (string= (substring result -1) "/"))))
(setq result (concat result "/")))
(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)))))
......@@ -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"
(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)))))))
(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
(all-completions
filename
(mapcar
'list
(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))
(tramp-flush-file-property v localname))
(all-completions
filename
;; 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
'list
(with-file-property v localname "file-name-all-completions"
(let (result)
(tramp-barf-unless-okay
(lambda (x)
(let ((cache-hit
(tramp-get-file-property
v
(format "cd %s" (tramp-shell-quote-argument localname))
"tramp-handle-file-name-all-completions: Couldn't `cd %s'"
(tramp-shell-quote-argument localname))
(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
(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")
(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)))
(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))
result)))))))
;; 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
(setq cmd-result
(tramp-send-command-and-check
v
(format "%s %s %s" cmd
(tramp-shell-quote-argument localname1)
(tramp-shell-quote-argument localname2)))
(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)))
(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))
(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-attributes filename))))
(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)))))
......@@ -7244,6 +7456,49 @@ Return 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.
If it doesn't exist, generate a new one."
......@@ -7707,8 +7962,21 @@ necessary only. This function will be used in file name completion."
(defun tramp-get-remote-perl (vec)
(with-connection-property vec "perl"
(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)))))
(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"
......@@ -7732,6 +8000,21 @@ necessary only. This function will be used in file name completion."
(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")
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment