310 lines
9.8 KiB
Haskell
310 lines
9.8 KiB
Haskell
{- Caching a file's inode, size, and modification time
|
|
- to see when it's changed.
|
|
-
|
|
- Copyright 2013-2019 Joey Hess <id@joeyh.name>
|
|
-
|
|
- License: BSD-2-clause
|
|
-}
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
{-# LANGUAGE TypeSynonymInstances #-}
|
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
|
|
module Utility.InodeCache (
|
|
InodeCache,
|
|
mkInodeCache,
|
|
InodeComparisonType(..),
|
|
inodeCacheFileSize,
|
|
|
|
compareStrong,
|
|
compareWeak,
|
|
compareBy,
|
|
|
|
readInodeCache,
|
|
showInodeCache,
|
|
genInodeCache,
|
|
toInodeCache,
|
|
toInodeCache',
|
|
|
|
InodeCacheKey,
|
|
inodeCacheToKey,
|
|
inodeCacheToFileSize,
|
|
inodeCacheToMtime,
|
|
inodeCacheToEpochTime,
|
|
inodeCacheEpochTimeRange,
|
|
replaceInode,
|
|
|
|
SentinalFile(..),
|
|
SentinalStatus(..),
|
|
TSDelta,
|
|
noTSDelta,
|
|
writeSentinalFile,
|
|
checkSentinalFile,
|
|
sentinalFileExists,
|
|
|
|
prop_read_show_inodecache
|
|
) where
|
|
|
|
import Common
|
|
import Utility.TimeStamp
|
|
import Utility.QuickCheck
|
|
import qualified Utility.RawFilePath as R
|
|
|
|
import System.PosixCompat.Types
|
|
import System.PosixCompat.Files (isRegularFile, fileID)
|
|
import Data.Time.Clock.POSIX
|
|
|
|
#ifndef mingw32_HOST_OS
|
|
import qualified System.Posix.Files as Posix
|
|
#endif
|
|
|
|
data InodeCachePrim = InodeCachePrim FileID FileSize MTime
|
|
deriving (Show, Eq, Ord)
|
|
|
|
newtype InodeCache = InodeCache InodeCachePrim
|
|
deriving (Show)
|
|
|
|
mkInodeCache :: FileID -> FileSize -> POSIXTime -> InodeCache
|
|
mkInodeCache inode sz mtime = InodeCache $
|
|
InodeCachePrim inode sz (MTimeHighRes mtime)
|
|
|
|
inodeCacheFileSize :: InodeCache -> FileSize
|
|
inodeCacheFileSize (InodeCache (InodeCachePrim _ sz _)) = sz
|
|
|
|
{- Inode caches can be compared in two different ways, either weakly
|
|
- or strongly. -}
|
|
data InodeComparisonType = Weakly | Strongly
|
|
deriving (Eq, Ord, Show)
|
|
|
|
{- Strong comparison, including inodes. -}
|
|
compareStrong :: InodeCache -> InodeCache -> Bool
|
|
compareStrong (InodeCache x) (InodeCache y) = x == y
|
|
|
|
{- Weak comparison of the inode caches, comparing the size and mtime,
|
|
- but not the actual inode. Useful when inodes have changed, perhaps
|
|
- due to some filesystems being remounted.
|
|
-
|
|
- The weak mtime comparison treats any mtimes that are within 2 seconds
|
|
- of one-another as the same. This is because FAT has only a 2 second
|
|
- resolution. When a FAT filesystem is used on Linux, higher resolution
|
|
- timestamps maybe are cached and used by Linux, but they are lost
|
|
- on unmount, so after a remount, the timestamp can appear to have changed.
|
|
-}
|
|
compareWeak :: InodeCache -> InodeCache -> Bool
|
|
compareWeak (InodeCache (InodeCachePrim _ size1 mtime1)) (InodeCache (InodeCachePrim _ size2 mtime2)) =
|
|
size1 == size2 && (abs (lowResTime mtime1 - lowResTime mtime2) < 2)
|
|
|
|
compareBy :: InodeComparisonType -> InodeCache -> InodeCache -> Bool
|
|
compareBy Strongly = compareStrong
|
|
compareBy Weakly = compareWeak
|
|
|
|
{- For use in a Map; it's determined at creation time whether this
|
|
- uses strong or weak comparison for Eq. -}
|
|
data InodeCacheKey = InodeCacheKey InodeComparisonType InodeCachePrim
|
|
deriving (Ord, Show)
|
|
|
|
instance Eq InodeCacheKey where
|
|
(InodeCacheKey ctx x) == (InodeCacheKey cty y) =
|
|
compareBy (maximum [ctx,cty]) (InodeCache x ) (InodeCache y)
|
|
|
|
inodeCacheToKey :: InodeComparisonType -> InodeCache -> InodeCacheKey
|
|
inodeCacheToKey ct (InodeCache prim) = InodeCacheKey ct prim
|
|
|
|
inodeCacheToFileSize :: InodeCache -> FileSize
|
|
inodeCacheToFileSize (InodeCache (InodeCachePrim _ sz _)) = sz
|
|
|
|
inodeCacheToMtime :: InodeCache -> POSIXTime
|
|
inodeCacheToMtime (InodeCache (InodeCachePrim _ _ mtime)) = highResTime mtime
|
|
|
|
inodeCacheToEpochTime :: InodeCache -> EpochTime
|
|
inodeCacheToEpochTime (InodeCache (InodeCachePrim _ _ mtime)) = lowResTime mtime
|
|
|
|
-- Returns min, max EpochTime that weakly match the time of the InodeCache.
|
|
inodeCacheEpochTimeRange :: InodeCache -> (EpochTime, EpochTime)
|
|
inodeCacheEpochTimeRange i =
|
|
let t = inodeCacheToEpochTime i
|
|
in (t-1, t+1)
|
|
|
|
replaceInode :: FileID -> InodeCache -> InodeCache
|
|
replaceInode inode (InodeCache (InodeCachePrim _ sz mtime)) =
|
|
InodeCache (InodeCachePrim inode sz mtime)
|
|
|
|
{- For backwards compatibility, support low-res mtime with no
|
|
- fractional seconds. -}
|
|
data MTime = MTimeLowRes EpochTime | MTimeHighRes POSIXTime
|
|
deriving (Show, Ord)
|
|
|
|
{- A low-res time compares equal to any high-res time in the same second. -}
|
|
instance Eq MTime where
|
|
MTimeLowRes a == MTimeLowRes b = a == b
|
|
MTimeHighRes a == MTimeHighRes b = a == b
|
|
MTimeHighRes a == MTimeLowRes b = lowResTime a == b
|
|
MTimeLowRes a == MTimeHighRes b = a == lowResTime b
|
|
|
|
class MultiResTime t where
|
|
lowResTime :: t -> EpochTime
|
|
highResTime :: t -> POSIXTime
|
|
|
|
instance MultiResTime EpochTime where
|
|
lowResTime = id
|
|
highResTime = realToFrac
|
|
|
|
instance MultiResTime POSIXTime where
|
|
lowResTime = fromInteger . floor
|
|
highResTime = id
|
|
|
|
instance MultiResTime MTime where
|
|
lowResTime (MTimeLowRes t) = t
|
|
lowResTime (MTimeHighRes t) = lowResTime t
|
|
highResTime (MTimeLowRes t) = highResTime t
|
|
highResTime (MTimeHighRes t) = t
|
|
|
|
showInodeCache :: InodeCache -> String
|
|
showInodeCache (InodeCache (InodeCachePrim inode size (MTimeHighRes mtime))) =
|
|
let (t, d) = separate (== '.') (takeWhile (/= 's') (show mtime))
|
|
in unwords
|
|
[ show inode
|
|
, show size
|
|
, t
|
|
, d
|
|
]
|
|
showInodeCache (InodeCache (InodeCachePrim inode size (MTimeLowRes mtime))) =
|
|
unwords
|
|
[ show inode
|
|
, show size
|
|
, show mtime
|
|
]
|
|
|
|
readInodeCache :: String -> Maybe InodeCache
|
|
readInodeCache s = case words s of
|
|
(inode:size:mtime:[]) -> do
|
|
i <- readish inode
|
|
sz <- readish size
|
|
t <- readish mtime
|
|
return $ InodeCache $ InodeCachePrim i sz (MTimeLowRes t)
|
|
(inode:size:mtime:mtimedecimal:_) -> do
|
|
i <- readish inode
|
|
sz <- readish size
|
|
t <- parsePOSIXTime $ mtime ++ '.' : mtimedecimal
|
|
return $ InodeCache $ InodeCachePrim i sz (MTimeHighRes t)
|
|
_ -> Nothing
|
|
|
|
genInodeCache :: RawFilePath -> TSDelta -> IO (Maybe InodeCache)
|
|
genInodeCache f delta = catchDefaultIO Nothing $
|
|
toInodeCache delta f =<< R.getSymbolicLinkStatus f
|
|
|
|
toInodeCache :: TSDelta -> RawFilePath -> FileStatus -> IO (Maybe InodeCache)
|
|
toInodeCache d f s = toInodeCache' d f s (fileID s)
|
|
|
|
toInodeCache' :: TSDelta -> RawFilePath -> FileStatus -> FileID -> IO (Maybe InodeCache)
|
|
toInodeCache' (TSDelta getdelta) f s inode
|
|
| isRegularFile s = do
|
|
delta <- getdelta
|
|
sz <- getFileSize' f s
|
|
#ifdef mingw32_HOST_OS
|
|
mtime <- utcTimeToPOSIXSeconds <$> getModificationTime (fromRawFilePath f)
|
|
#else
|
|
let mtime = Posix.modificationTimeHiRes s
|
|
#endif
|
|
return $ Just $ InodeCache $ InodeCachePrim inode sz (MTimeHighRes (mtime + highResTime delta))
|
|
| otherwise = pure Nothing
|
|
|
|
{- Some filesystem get new random inodes each time they are mounted.
|
|
- To detect this and other problems, a sentinal file can be created.
|
|
- Its InodeCache at the time of its creation is written to the cache file,
|
|
- so changes can later be detected. -}
|
|
data SentinalFile = SentinalFile
|
|
{ sentinalFile :: RawFilePath
|
|
, sentinalCacheFile :: RawFilePath
|
|
}
|
|
deriving (Show)
|
|
|
|
{- On Windows, the mtime of a file appears to change when the time zone is
|
|
- changed. To deal with this, a TSDelta can be used; the delta is added to
|
|
- the mtime when generating an InodeCache. The current delta can be found
|
|
- by looking at the SentinalFile. Effectively, this makes all InodeCaches
|
|
- use the same time zone that was in use when the sential file was
|
|
- originally written. -}
|
|
newtype TSDelta = TSDelta (IO EpochTime)
|
|
|
|
noTSDelta :: TSDelta
|
|
noTSDelta = TSDelta (pure 0)
|
|
|
|
writeSentinalFile :: SentinalFile -> IO ()
|
|
writeSentinalFile s = do
|
|
writeFile (fromRawFilePath (sentinalFile s)) ""
|
|
maybe noop (writeFile (fromRawFilePath (sentinalCacheFile s)) . showInodeCache)
|
|
=<< genInodeCache (sentinalFile s) noTSDelta
|
|
|
|
data SentinalStatus = SentinalStatus
|
|
{ sentinalInodesChanged :: Bool
|
|
, sentinalTSDelta :: TSDelta
|
|
}
|
|
|
|
{- Checks if the InodeCache of the sentinal file is the same
|
|
- as it was when it was originally created.
|
|
-
|
|
- On Windows, time stamp differences are ignored, since they change
|
|
- with the timezone.
|
|
-
|
|
- When the sential file does not exist, InodeCaches cannot reliably be
|
|
- compared, so the assumption is that there is has been a change.
|
|
-}
|
|
checkSentinalFile :: SentinalFile -> IO SentinalStatus
|
|
checkSentinalFile s = do
|
|
mold <- loadoldcache
|
|
case mold of
|
|
Nothing -> return dummy
|
|
(Just old) -> do
|
|
mnew <- gennewcache
|
|
case mnew of
|
|
Nothing -> return dummy
|
|
Just new -> return $ calc old new
|
|
where
|
|
loadoldcache = catchDefaultIO Nothing $
|
|
readInodeCache <$> readFile (fromRawFilePath (sentinalCacheFile s))
|
|
gennewcache = genInodeCache (sentinalFile s) noTSDelta
|
|
calc (InodeCache (InodeCachePrim oldinode oldsize oldmtime)) (InodeCache (InodeCachePrim newinode newsize newmtime)) =
|
|
SentinalStatus (not unchanged) tsdelta
|
|
where
|
|
#ifdef mingw32_HOST_OS
|
|
-- Since mtime can appear to change when the time zone is
|
|
-- changed in windows, we cannot look at the mtime for the
|
|
-- sentinal file.
|
|
unchanged = oldinode == newinode && oldsize == newsize && (newmtime == newmtime)
|
|
tsdelta = TSDelta $ do
|
|
-- Run when generating an InodeCache,
|
|
-- to get the current delta.
|
|
mnew <- gennewcache
|
|
return $ case mnew of
|
|
Just (InodeCache (InodeCachePrim _ _ currmtime)) ->
|
|
lowResTime oldmtime - lowResTime currmtime
|
|
Nothing -> 0
|
|
#else
|
|
unchanged = oldinode == newinode && oldsize == newsize && oldmtime == newmtime
|
|
tsdelta = noTSDelta
|
|
#endif
|
|
dummy = SentinalStatus True noTSDelta
|
|
|
|
sentinalFileExists :: SentinalFile -> IO Bool
|
|
sentinalFileExists s = allM R.doesPathExist [sentinalCacheFile s, sentinalFile s]
|
|
|
|
instance Arbitrary InodeCache where
|
|
arbitrary =
|
|
let prim = InodeCachePrim
|
|
<$> arbitrary
|
|
<*> arbitrary
|
|
<*> arbitrary
|
|
in InodeCache <$> prim
|
|
|
|
instance Arbitrary MTime where
|
|
arbitrary = frequency
|
|
-- timestamp is not usually negative
|
|
[ (50, MTimeLowRes <$> (abs . fromInteger <$> arbitrary))
|
|
, (50, MTimeHighRes <$> arbitrary)
|
|
]
|
|
|
|
prop_read_show_inodecache :: InodeCache -> Bool
|
|
prop_read_show_inodecache c = case readInodeCache (showInodeCache c) of
|
|
Nothing -> False
|
|
Just c' -> compareStrong c c'
|