add inodes to kqueue's directory cache

This is necessary to generate events when a file is deleted and immediately
replaced. Otherwise, the cache will have the old file, and so no event
would be generated.

Use of getFileStatus is suboptimal, it would be faster to use
the inode returned by readdir -- but getDirectoryContents does not expose
it, so I'd have to copy and modify a lot of low-level code.
This commit is contained in:
Joey Hess 2012-07-17 15:57:49 -04:00
parent cfccfc19e0
commit e816776a62

View file

@ -22,6 +22,7 @@ module Utility.Kqueue (
import Common import Common
import Utility.Types.DirWatcher import Utility.Types.DirWatcher
import System.Posix.Directory
import System.Posix.Types import System.Posix.Types
import Foreign.C.Types import Foreign.C.Types
import Foreign.C.Error import Foreign.C.Error
@ -62,15 +63,19 @@ type DirMap = M.Map Fd DirInfo
{- A directory, and its last known contents (with filenames relative to it) -} {- A directory, and its last known contents (with filenames relative to it) -}
data DirInfo = DirInfo data DirInfo = DirInfo
{ dirName :: FilePath { dirName :: FilePath
, dirCache :: S.Set FilePath , dirCache :: S.Set (FilePath, FileID)
} }
deriving (Show) deriving (Show)
getDirInfo :: FilePath -> IO DirInfo getDirInfo :: FilePath -> IO DirInfo
getDirInfo dir = do getDirInfo dir = do
contents <- S.fromList . filter (not . dirCruft) l <- filter (not . dirCruft) <$> getDirectoryContents dir
<$> getDirectoryContents dir contents <- S.fromList <$> mapM addinode l
return $ DirInfo dir contents return $ DirInfo dir contents
where
addinode f = do
inode <- fileID <$> getFileStatus (dir </> f)
return (f, inode)
{- Difference between the dirCaches of two DirInfos. -} {- Difference between the dirCaches of two DirInfos. -}
(//) :: DirInfo -> DirInfo -> [Change] (//) :: DirInfo -> DirInfo -> [Change]
@ -78,7 +83,7 @@ oldc // newc = deleted ++ added
where where
deleted = calc Deleted oldc newc deleted = calc Deleted oldc newc
added = calc Added newc oldc added = calc Added newc oldc
calc a x y = map a . map (dirName x </>) $ calc a x y = map a . map (dirName x </>) . map fst $
S.toList $ S.difference (dirCache x) (dirCache y) S.toList $ S.difference (dirCache x) (dirCache y)
{- Builds a map of directories in a tree, possibly pruning some. {- Builds a map of directories in a tree, possibly pruning some.
@ -99,7 +104,7 @@ scanRecursive topdir prune = M.fromList <$> walk [] [topdir]
case mfd of case mfd of
Nothing -> walk c rest Nothing -> walk c rest
Just fd -> do Just fd -> do
let subdirs = map (dir </>) $ let subdirs = map (dir </>) . map fst $
S.toList $ dirCache info S.toList $ dirCache info
walk ((fd, info):c) (subdirs ++ rest) walk ((fd, info):c) (subdirs ++ rest)
@ -123,7 +128,8 @@ removeSubDir dirmap dir = do
findDirContents :: DirMap -> FilePath -> [FilePath] findDirContents :: DirMap -> FilePath -> [FilePath]
findDirContents dirmap dir = concatMap absolutecontents $ search findDirContents dirmap dir = concatMap absolutecontents $ search
where where
absolutecontents i = map (dirName i </>) (S.toList $ dirCache i) absolutecontents i = map (dirName i </>)
(map fst $ S.toList $ dirCache i)
search = map snd $ M.toList $ search = map snd $ M.toList $
M.filter (\i -> dirName i == dir) dirmap M.filter (\i -> dirName i == dir) dirmap