mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-16 19:00:55 -08:00
Code Issues Projects Releases Wiki Activity

* net/tramp.el (tramp-handle-file-truename): Cache only the local

Browse source 
file name.

* net/tramp-cache.el (tramp-flush-file-property): Flush also
properties of linked files.  (Bug#9879)
This commit is contained in:
Michael Albinus 2011-11-16 22:32:46 +01:00
parent 9d0cfcd67d
commit d0c8fc8abb
3 changed files with 114 additions and 97 deletions
Download patch file Download diff file Expand all files Collapse all files

8
lisp/ChangeLog
View file

@ -1,3 +1,11 @@
2011-11-16 Michael Albinus <michael.albinus@gmx.de>
* net/tramp.el (tramp-handle-file-truename): Cache only the local
file name.
* net/tramp-cache.el (tramp-flush-file-property): Flush also
properties of linked files. (Bug#9879)
2011-11-16 Juanma Barranquero <lekktu@gmail.com> 2011-11-16 Juanma Barranquero <lekktu@gmail.com>
* menu-bar.el (menu-bar-file-menu): * menu-bar.el (menu-bar-file-menu):

5
lisp/net/tramp-cache.el
View file

@ -162,6 +162,11 @@ FILE must be a local file name on a connection identified via VEC."
;;;###tramp-autoload ;;;###tramp-autoload
(defun tramp-flush-file-property (vec file) (defun tramp-flush-file-property (vec file)
"Remove all properties of FILE in the cache context of VEC." "Remove all properties of FILE in the cache context of VEC."
;; Remove file property of symlinks.
(let ((truename (tramp-get-file-property vec file "file-truename" nil)))
(when (and (stringp truename)
(not (string-equal file truename)))
(tramp-flush-file-property vec truename)))
;; Unify localname. ;; Unify localname.
(setq vec (copy-sequence vec)) (setq vec (copy-sequence vec))
(aset vec 3 (tramp-run-real-handler 'directory-file-name (list file))) (aset vec 3 (tramp-run-real-handler 'directory-file-name (list file)))

198
lisp/net/tramp-sh.el
View file

@ -1058,106 +1058,110 @@ target of the symlink differ."
(defun tramp-sh-handle-file-truename (filename &optional counter prev-dirs) (defun tramp-sh-handle-file-truename (filename &optional counter prev-dirs)
"Like `file-truename' for Tramp files." "Like `file-truename' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name filename) nil (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-file-property v localname "file-truename" (tramp-make-tramp-file-name method user host
(let ((result nil)) ; result steps in reverse order (with-file-property v localname "file-truename"
(tramp-message v 4 "Finding true name for `%s'" filename) (let ((result nil)) ; result steps in reverse order
(cond (tramp-message v 4 "Finding true name for `%s'" filename)
;; Use GNU readlink --canonicalize-missing where available. (cond
((tramp-get-remote-readlink v) ;; Use GNU readlink --canonicalize-missing where available.
(setq result ((tramp-get-remote-readlink v)
(tramp-send-command-and-read (setq result
v (tramp-send-command-and-read
(format "echo \"\\\"`%s --canonicalize-missing %s`\\\"\"" v
(tramp-get-remote-readlink v) (format "echo \"\\\"`%s --canonicalize-missing %s`\\\"\""
(tramp-shell-quote-argument localname))))) (tramp-get-remote-readlink v)
(tramp-shell-quote-argument localname)))))
;; Use Perl implementation. ;; Use Perl implementation.
((and (tramp-get-remote-perl v) ((and (tramp-get-remote-perl v)
(tramp-get-connection-property v "perl-file-spec" nil) (tramp-get-connection-property v "perl-file-spec" nil)
(tramp-get-connection-property v "perl-cwd-realpath" nil)) (tramp-get-connection-property v "perl-cwd-realpath" nil))
(tramp-maybe-send-script (tramp-maybe-send-script
v tramp-perl-file-truename "tramp_perl_file_truename") v tramp-perl-file-truename "tramp_perl_file_truename")
(setq result (setq result
(tramp-send-command-and-read (tramp-send-command-and-read
v v
(format "tramp_perl_file_truename %s" (format "tramp_perl_file_truename %s"
(tramp-shell-quote-argument localname))))) (tramp-shell-quote-argument localname)))))
;; Do it yourself. We bind `directory-sep-char' here for ;; Do it yourself. We bind `directory-sep-char' here for
;; XEmacs on Windows, which would otherwise use backslash. ;; XEmacs on Windows, which would otherwise use backslash.
(t (let* ((directory-sep-char ?/) (t (let* ((directory-sep-char ?/)
(steps (tramp-compat-split-string localname "/")) (steps (tramp-compat-split-string localname "/"))
(localnamedir (tramp-run-real-handler (localnamedir (tramp-run-real-handler
'file-name-as-directory (list localname))) 'file-name-as-directory (list localname)))
(is-dir (string= localname localnamedir)) (is-dir (string= localname localnamedir))
(thisstep nil) (thisstep nil)
(numchase 0) (numchase 0)
;; Don't make the following value larger than ;; Don't make the following value larger than
;; necessary. People expect an error message in a ;; necessary. People expect an error message in
;; timely fashion when something is wrong; ;; a timely fashion when something is wrong;
;; otherwise they might think that Emacs is hung. ;; otherwise they might think that Emacs is hung.
;; Of course, correctness has to come first. ;; Of course, correctness has to come first.
(numchase-limit 20) (numchase-limit 20)
symlink-target) symlink-target)
(while (and steps (< numchase numchase-limit)) (while (and steps (< numchase numchase-limit))
(setq thisstep (pop steps)) (setq thisstep (pop steps))
(tramp-message (tramp-message
v 5 "Check %s" v 5 "Check %s"
(mapconcat 'identity (mapconcat 'identity
(append '("") (reverse result) (list thisstep)) (append '("") (reverse result) (list thisstep))
"/")) "/"))
(setq symlink-target (setq symlink-target
(nth 0 (file-attributes (nth 0 (file-attributes
(tramp-make-tramp-file-name (tramp-make-tramp-file-name
method user host method user host
(mapconcat 'identity (mapconcat 'identity
(append '("") (append '("")
(reverse result) (reverse result)
(list thisstep)) (list thisstep))
"/"))))) "/")))))
(cond ((string= "." thisstep) (cond ((string= "." thisstep)
(tramp-message v 5 "Ignoring step `.'")) (tramp-message v 5 "Ignoring step `.'"))
((string= ".." thisstep) ((string= ".." thisstep)
(tramp-message v 5 "Processing step `..'") (tramp-message v 5 "Processing step `..'")
(pop result)) (pop result))
((stringp symlink-target) ((stringp symlink-target)
;; It's a symlink, follow it. ;; It's a symlink, follow it.
(tramp-message v 5 "Follow symlink to %s" symlink-target) (tramp-message
(setq numchase (1+ numchase)) v 5 "Follow symlink to %s" symlink-target)
(when (file-name-absolute-p symlink-target) (setq numchase (1+ numchase))
(setq result nil)) (when (file-name-absolute-p symlink-target)
;; If the symlink was absolute, we'll get a string like (setq result nil))
;; "/user@host:/some/target"; extract the ;; If the symlink was absolute, we'll get a
;; "/some/target" part from it. ;; string like "/user@host:/some/target";
(when (tramp-tramp-file-p symlink-target) ;; extract the "/some/target" part from it.
(unless (tramp-equal-remote filename symlink-target) (when (tramp-tramp-file-p symlink-target)
(tramp-error (unless (tramp-equal-remote filename symlink-target)
v 'file-error (tramp-error
"Symlink target `%s' on wrong host" symlink-target)) v 'file-error
(setq symlink-target localname)) "Symlink target `%s' on wrong host"
(setq steps symlink-target))
(append (tramp-compat-split-string (setq symlink-target localname))
symlink-target "/") (setq steps
steps))) (append (tramp-compat-split-string
(t symlink-target "/")
;; It's a file. steps)))
(setq result (cons thisstep result))))) (t
(when (>= numchase numchase-limit) ;; It's a file.
(tramp-error (setq result (cons thisstep result)))))
v 'file-error (when (>= numchase numchase-limit)
"Maximum number (%d) of symlinks exceeded" numchase-limit)) (tramp-error
(setq result (reverse result)) v 'file-error
;; Combine list to form string. "Maximum number (%d) of symlinks exceeded" numchase-limit))
(setq result (setq result (reverse result))
(if result ;; Combine list to form string.
(mapconcat 'identity (cons "" result) "/") (setq result
"/")) (if result
(when (and is-dir (or (string= "" result) (mapconcat 'identity (cons "" result) "/")
(not (string= (substring result -1) "/")))) "/"))
(setq result (concat 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-message v 4 "True name of `%s' is `%s'" localname result)
(tramp-make-tramp-file-name method user host result))))) result)))))
;; Basic functions. ;; Basic functions.