X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/94cc397c541f50af6b049af6c42806daa2be2709..e8e14166989dc9034e2d34c2070803b8a6136763:/lisp/net/tramp-cache.el diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 4654c212ee..77aad29faa 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -1,6 +1,7 @@ ;;; tramp-cache.el --- file information caching for Tramp -;; Copyright (C) 2000, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2005, 2006, 2007, 2008, +;; 2009 Free Software Foundation, Inc. ;; Author: Daniel Pittman ;; Michael Albinus @@ -8,10 +9,10 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -19,8 +20,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, see -;; . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -61,6 +61,8 @@ (autoload 'tramp-file-name-user "tramp") (autoload 'tramp-file-name-host "tramp") (autoload 'tramp-file-name-localname "tramp") + (autoload 'tramp-run-real-handler "tramp") + (autoload 'tramp-time-less-p "tramp") (autoload 'time-stamp-string "time-stamp")) ;;; -- Cache -- @@ -68,6 +70,13 @@ (defvar tramp-cache-data (make-hash-table :test 'equal) "Hash table for remote files properties.") +(defvar tramp-cache-inhibit-cache nil + "Inhibit cache read access, when `t'. +`nil' means to accept cache entries unconditionally. If the +value is a timestamp (as returned by `current-time'), cache +entries are not used when they have been written before this +time.") + (defcustom tramp-persistency-file-name (cond ;; GNU Emacs. @@ -90,18 +99,33 @@ :group 'tramp :type 'file) +(defvar tramp-cache-data-changed nil + "Whether persistent cache data have been changed.") + (defun tramp-get-file-property (vec file property default) "Get the PROPERTY of FILE from the cache context of VEC. Returns DEFAULT if not set." ;; Unify localname. (setq vec (copy-sequence vec)) - (aset vec 3 (directory-file-name file)) + (aset vec 3 (tramp-run-real-handler 'directory-file-name (list file))) (let* ((hash (or (gethash vec tramp-cache-data) (puthash vec (make-hash-table :test 'equal) tramp-cache-data))) - (value (if (hash-table-p hash) - (gethash property hash default) - default))) + (value (when (hash-table-p hash) (gethash property hash)))) + (if + ;; We take the value only if there is any, and + ;; `tramp-cache-inhibit-cache' indicates that it is still + ;; valid. Otherwise, DEFAULT is set. + (and (consp value) + (or (null tramp-cache-inhibit-cache) + (and (consp tramp-cache-inhibit-cache) + (tramp-time-less-p + tramp-cache-inhibit-cache (car value))))) + (setq value (cdr value)) + (setq value default)) + + (if (consp tramp-cache-inhibit-cache) + (tramp-message vec 1 "%s %s %s" file property value)) (tramp-message vec 8 "%s %s %s" file property value) value)) @@ -110,11 +134,12 @@ Returns DEFAULT if not set." Returns VALUE." ;; Unify localname. (setq vec (copy-sequence vec)) - (aset vec 3 (directory-file-name file)) + (aset vec 3 (tramp-run-real-handler 'directory-file-name (list file))) (let ((hash (or (gethash vec tramp-cache-data) (puthash vec (make-hash-table :test 'equal) tramp-cache-data)))) - (puthash property value hash) + ;; We put the timestamp there. + (puthash property (cons (current-time) value) hash) (tramp-message vec 8 "%s %s %s" file property value) value)) @@ -122,18 +147,19 @@ Returns VALUE." "Remove all properties of FILE in the cache context of VEC." ;; Unify localname. (setq vec (copy-sequence vec)) - (aset vec 3 (directory-file-name file)) + (aset vec 3 (tramp-run-real-handler 'directory-file-name (list file))) (tramp-message vec 8 "%s" file) (remhash vec tramp-cache-data)) (defun tramp-flush-directory-property (vec directory) "Remove all properties of DIRECTORY in the cache context of VEC. Remove also properties of all files in subdirectories." - (let ((directory (directory-file-name directory))) + (let ((directory (tramp-run-real-handler + 'directory-file-name (list directory)))) (tramp-message vec 8 "%s" directory) (maphash '(lambda (key value) - (when (and (stringp key) + (when (and (stringp (tramp-file-name-localname key)) (string-match directory (tramp-file-name-localname key))) (remhash key tramp-cache-data))) tramp-cache-data))) @@ -143,7 +169,7 @@ Remove also properties of all files in subdirectories." ;; not show proper directory contents when a file has been copied or ;; deleted before. (defun tramp-flush-file-function () - "Flush all Tramp cache properties from buffer-file-name." + "Flush all Tramp cache properties from `buffer-file-name'." (let ((bfn (if (stringp (buffer-file-name)) (buffer-file-name) default-directory))) @@ -177,8 +203,8 @@ If the value is not set for the connection, returns DEFAULT." (aset key 3 nil)) (let* ((hash (gethash key tramp-cache-data)) (value (if (hash-table-p hash) - (gethash property hash default) - default))) + (gethash property hash default) + default))) (tramp-message key 7 "%s %s" property value) value)) @@ -195,6 +221,7 @@ PROPERTY is set persistent when KEY is a vector." (puthash key (make-hash-table :test 'equal) tramp-cache-data)))) (puthash property value hash) + (setq tramp-cache-data-changed t) ;; This function is called also during initialization of ;; tramp-cache.el. `tramp-message´ is not defined yet at this ;; time, so we ignore the corresponding error. @@ -203,17 +230,24 @@ PROPERTY is set persistent when KEY is a vector." (error nil)) value)) -(defun tramp-flush-connection-property (key event) +(defun tramp-flush-connection-property (key) "Remove all properties identified by KEY. -KEY identifies the connection, it is either a process or a -vector. EVENT is not used, it is just applied because this -function is intended to run also as process sentinel." +KEY identifies the connection, it is either a process or a vector." ;; Unify key by removing localname from vector. Work with a copy in ;; order to avoid side effects. (when (vectorp key) (setq key (copy-sequence key)) (aset key 3 nil)) -; (tramp-message key 7 "%s" event) + (tramp-message + key 7 "%s %s" key + (let ((hash (gethash key tramp-cache-data)) + properties) + (if (hash-table-p hash) + (maphash + (lambda (x y) (add-to-list 'properties x 'append)) + (gethash key tramp-cache-data))) + properties)) + (setq tramp-cache-data-changed t) (remhash key tramp-cache-data)) (defun tramp-cache-print (table) @@ -252,6 +286,7 @@ function is intended to run also as process sentinel." (condition-case nil (when (and (hash-table-p tramp-cache-data) (not (zerop (hash-table-count tramp-cache-data))) + tramp-cache-data-changed (stringp tramp-persistency-file-name)) (let ((cache (copy-hash-table tramp-cache-data))) ;; Remove temporary data. @@ -292,8 +327,7 @@ function is intended to run also as process sentinel." (defun tramp-parse-connection-properties (method) "Return a list of (user host) tuples allowed to access for METHOD. This function is added always in `tramp-get-completion-function' -for all methods. Resulting data are derived from connection -history." +for all methods. Resulting data are derived from connection history." (let (res) (maphash '(lambda (key value) @@ -317,7 +351,8 @@ history." (while (setq element (pop list)) (setq key (pop element)) (while (setq item (pop element)) - (tramp-set-connection-property key (pop item) (car item)))))) + (tramp-set-connection-property key (pop item) (car item))))) + (setq tramp-cache-data-changed nil)) (file-error ;; Most likely because the file doesn't exist yet. No message. (clrhash tramp-cache-data))