summaryrefslogtreecommitdiff
path: root/lisp/net
diff options
context:
space:
mode:
authorMichael Albinus <michael.albinus@gmx.de>2009-10-26 09:29:12 +0000
committerMichael Albinus <michael.albinus@gmx.de>2009-10-26 09:29:12 +0000
commit293c24f9ad59130eb8ae53b3adbd61b5fb634084 (patch)
tree73974be71a1677648d053bf5b996a280974f6618 /lisp/net
parent36f1267e808dcc3ff406da564a29c0b7180315d9 (diff)
downloademacs-293c24f9ad59130eb8ae53b3adbd61b5fb634084.tar.gz
* 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.
Diffstat (limited to 'lisp/net')
-rw-r--r--lisp/net/tramp.el589
1 files changed, 436 insertions, 153 deletions
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index bd1e7f46d9d..f89c32102e2 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -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))
(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")
- (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"
@@ -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")