1{- Caching a file's inode, size, and modification time 2 - to see when it's changed. 3 - 4 - Copyright 2013-2019 Joey Hess <id@joeyh.name> 5 - 6 - License: BSD-2-clause 7 -} 8 9{-# LANGUAGE CPP #-} 10{-# LANGUAGE TypeSynonymInstances #-} 11{-# OPTIONS_GHC -fno-warn-orphans #-} 12 13module Utility.InodeCache ( 14 InodeCache, 15 mkInodeCache, 16 InodeComparisonType(..), 17 inodeCacheFileSize, 18 19 compareStrong, 20 compareWeak, 21 compareBy, 22 23 readInodeCache, 24 showInodeCache, 25 genInodeCache, 26 toInodeCache, 27 toInodeCache', 28 29 InodeCacheKey, 30 inodeCacheToKey, 31 inodeCacheToFileSize, 32 inodeCacheToMtime, 33 inodeCacheToEpochTime, 34 inodeCacheEpochTimeRange, 35 36 SentinalFile(..), 37 SentinalStatus(..), 38 TSDelta, 39 noTSDelta, 40 writeSentinalFile, 41 checkSentinalFile, 42 sentinalFileExists, 43 44 prop_read_show_inodecache 45) where 46 47import Common 48import Utility.TimeStamp 49import Utility.QuickCheck 50import qualified Utility.RawFilePath as R 51 52import System.PosixCompat.Types 53import Data.Time.Clock.POSIX 54 55#ifdef mingw32_HOST_OS 56import Data.Word (Word64) 57#else 58import System.Posix.Files 59#endif 60 61data InodeCachePrim = InodeCachePrim FileID FileSize MTime 62 deriving (Show, Eq, Ord) 63 64newtype InodeCache = InodeCache InodeCachePrim 65 deriving (Show) 66 67mkInodeCache :: FileID -> FileSize -> POSIXTime -> InodeCache 68mkInodeCache inode sz mtime = InodeCache $ 69 InodeCachePrim inode sz (MTimeHighRes mtime) 70 71inodeCacheFileSize :: InodeCache -> FileSize 72inodeCacheFileSize (InodeCache (InodeCachePrim _ sz _)) = sz 73 74{- Inode caches can be compared in two different ways, either weakly 75 - or strongly. -} 76data InodeComparisonType = Weakly | Strongly 77 deriving (Eq, Ord, Show) 78 79{- Strong comparison, including inodes. -} 80compareStrong :: InodeCache -> InodeCache -> Bool 81compareStrong (InodeCache x) (InodeCache y) = x == y 82 83{- Weak comparison of the inode caches, comparing the size and mtime, 84 - but not the actual inode. Useful when inodes have changed, perhaps 85 - due to some filesystems being remounted. 86 - 87 - The weak mtime comparison treats any mtimes that are within 2 seconds 88 - of one-another as the same. This is because FAT has only a 2 second 89 - resolution. When a FAT filesystem is used on Linux, higher resolution 90 - timestamps maybe are cached and used by Linux, but they are lost 91 - on unmount, so after a remount, the timestamp can appear to have changed. 92 -} 93compareWeak :: InodeCache -> InodeCache -> Bool 94compareWeak (InodeCache (InodeCachePrim _ size1 mtime1)) (InodeCache (InodeCachePrim _ size2 mtime2)) = 95 size1 == size2 && (abs (lowResTime mtime1 - lowResTime mtime2) < 2) 96 97compareBy :: InodeComparisonType -> InodeCache -> InodeCache -> Bool 98compareBy Strongly = compareStrong 99compareBy Weakly = compareWeak 100 101{- For use in a Map; it's determined at creation time whether this 102 - uses strong or weak comparison for Eq. -} 103data InodeCacheKey = InodeCacheKey InodeComparisonType InodeCachePrim 104 deriving (Ord, Show) 105 106instance Eq InodeCacheKey where 107 (InodeCacheKey ctx x) == (InodeCacheKey cty y) = 108 compareBy (maximum [ctx,cty]) (InodeCache x ) (InodeCache y) 109 110inodeCacheToKey :: InodeComparisonType -> InodeCache -> InodeCacheKey 111inodeCacheToKey ct (InodeCache prim) = InodeCacheKey ct prim 112 113inodeCacheToFileSize :: InodeCache -> FileSize 114inodeCacheToFileSize (InodeCache (InodeCachePrim _ sz _)) = sz 115 116inodeCacheToMtime :: InodeCache -> POSIXTime 117inodeCacheToMtime (InodeCache (InodeCachePrim _ _ mtime)) = highResTime mtime 118 119inodeCacheToEpochTime :: InodeCache -> EpochTime 120inodeCacheToEpochTime (InodeCache (InodeCachePrim _ _ mtime)) = lowResTime mtime 121 122-- Returns min, max EpochTime that weakly match the time of the InodeCache. 123inodeCacheEpochTimeRange :: InodeCache -> (EpochTime, EpochTime) 124inodeCacheEpochTimeRange i = 125 let t = inodeCacheToEpochTime i 126 in (t-1, t+1) 127 128{- For backwards compatability, support low-res mtime with no 129 - fractional seconds. -} 130data MTime = MTimeLowRes EpochTime | MTimeHighRes POSIXTime 131 deriving (Show, Ord) 132 133{- A low-res time compares equal to any high-res time in the same second. -} 134instance Eq MTime where 135 MTimeLowRes a == MTimeLowRes b = a == b 136 MTimeHighRes a == MTimeHighRes b = a == b 137 MTimeHighRes a == MTimeLowRes b = lowResTime a == b 138 MTimeLowRes a == MTimeHighRes b = a == lowResTime b 139 140class MultiResTime t where 141 lowResTime :: t -> EpochTime 142 highResTime :: t -> POSIXTime 143 144instance MultiResTime EpochTime where 145 lowResTime = id 146 highResTime = realToFrac 147 148instance MultiResTime POSIXTime where 149 lowResTime = fromInteger . floor 150 highResTime = id 151 152instance MultiResTime MTime where 153 lowResTime (MTimeLowRes t) = t 154 lowResTime (MTimeHighRes t) = lowResTime t 155 highResTime (MTimeLowRes t) = highResTime t 156 highResTime (MTimeHighRes t) = t 157 158showInodeCache :: InodeCache -> String 159showInodeCache (InodeCache (InodeCachePrim inode size (MTimeHighRes mtime))) = 160 let (t, d) = separate (== '.') (takeWhile (/= 's') (show mtime)) 161 in unwords 162 [ show inode 163 , show size 164 , t 165 , d 166 ] 167showInodeCache (InodeCache (InodeCachePrim inode size (MTimeLowRes mtime))) = 168 unwords 169 [ show inode 170 , show size 171 , show mtime 172 ] 173 174readInodeCache :: String -> Maybe InodeCache 175readInodeCache s = case words s of 176 (inode:size:mtime:[]) -> do 177 i <- readish inode 178 sz <- readish size 179 t <- readish mtime 180 return $ InodeCache $ InodeCachePrim i sz (MTimeLowRes t) 181 (inode:size:mtime:mtimedecimal:_) -> do 182 i <- readish inode 183 sz <- readish size 184 t <- parsePOSIXTime $ mtime ++ '.' : mtimedecimal 185 return $ InodeCache $ InodeCachePrim i sz (MTimeHighRes t) 186 _ -> Nothing 187 188genInodeCache :: RawFilePath -> TSDelta -> IO (Maybe InodeCache) 189genInodeCache f delta = catchDefaultIO Nothing $ 190 toInodeCache delta f =<< R.getFileStatus f 191 192toInodeCache :: TSDelta -> RawFilePath -> FileStatus -> IO (Maybe InodeCache) 193toInodeCache d f s = toInodeCache' d f s (fileID s) 194 195toInodeCache' :: TSDelta -> RawFilePath -> FileStatus -> FileID -> IO (Maybe InodeCache) 196toInodeCache' (TSDelta getdelta) f s inode 197 | isRegularFile s = do 198 delta <- getdelta 199 sz <- getFileSize' f s 200#ifdef mingw32_HOST_OS 201 mtime <- utcTimeToPOSIXSeconds <$> getModificationTime (fromRawFilePath f) 202#else 203 let mtime = modificationTimeHiRes s 204#endif 205 return $ Just $ InodeCache $ InodeCachePrim inode sz (MTimeHighRes (mtime + highResTime delta)) 206 | otherwise = pure Nothing 207 208{- Some filesystem get new random inodes each time they are mounted. 209 - To detect this and other problems, a sentinal file can be created. 210 - Its InodeCache at the time of its creation is written to the cache file, 211 - so changes can later be detected. -} 212data SentinalFile = SentinalFile 213 { sentinalFile :: RawFilePath 214 , sentinalCacheFile :: RawFilePath 215 } 216 deriving (Show) 217 218{- On Windows, the mtime of a file appears to change when the time zone is 219 - changed. To deal with this, a TSDelta can be used; the delta is added to 220 - the mtime when generating an InodeCache. The current delta can be found 221 - by looking at the SentinalFile. Effectively, this makes all InodeCaches 222 - use the same time zone that was in use when the sential file was 223 - originally written. -} 224newtype TSDelta = TSDelta (IO EpochTime) 225 226noTSDelta :: TSDelta 227noTSDelta = TSDelta (pure 0) 228 229writeSentinalFile :: SentinalFile -> IO () 230writeSentinalFile s = do 231 writeFile (fromRawFilePath (sentinalFile s)) "" 232 maybe noop (writeFile (fromRawFilePath (sentinalCacheFile s)) . showInodeCache) 233 =<< genInodeCache (sentinalFile s) noTSDelta 234 235data SentinalStatus = SentinalStatus 236 { sentinalInodesChanged :: Bool 237 , sentinalTSDelta :: TSDelta 238 } 239 240{- Checks if the InodeCache of the sentinal file is the same 241 - as it was when it was originally created. 242 - 243 - On Windows, time stamp differences are ignored, since they change 244 - with the timezone. 245 - 246 - When the sential file does not exist, InodeCaches canot reliably be 247 - compared, so the assumption is that there is has been a change. 248 -} 249checkSentinalFile :: SentinalFile -> IO SentinalStatus 250checkSentinalFile s = do 251 mold <- loadoldcache 252 case mold of 253 Nothing -> return dummy 254 (Just old) -> do 255 mnew <- gennewcache 256 case mnew of 257 Nothing -> return dummy 258 Just new -> return $ calc old new 259 where 260 loadoldcache = catchDefaultIO Nothing $ 261 readInodeCache <$> readFile (fromRawFilePath (sentinalCacheFile s)) 262 gennewcache = genInodeCache (sentinalFile s) noTSDelta 263 calc (InodeCache (InodeCachePrim oldinode oldsize oldmtime)) (InodeCache (InodeCachePrim newinode newsize newmtime)) = 264 SentinalStatus (not unchanged) tsdelta 265 where 266#ifdef mingw32_HOST_OS 267 -- Since mtime can appear to change when the time zone is 268 -- changed in windows, we cannot look at the mtime for the 269 -- sentinal file. 270 unchanged = oldinode == newinode && oldsize == newsize && (newmtime == newmtime) 271 tsdelta = TSDelta $ do 272 -- Run when generating an InodeCache, 273 -- to get the current delta. 274 mnew <- gennewcache 275 return $ case mnew of 276 Just (InodeCache (InodeCachePrim _ _ currmtime)) -> 277 lowResTime oldmtime - lowResTime currmtime 278 Nothing -> 0 279#else 280 unchanged = oldinode == newinode && oldsize == newsize && oldmtime == newmtime 281 tsdelta = noTSDelta 282#endif 283 dummy = SentinalStatus True noTSDelta 284 285sentinalFileExists :: SentinalFile -> IO Bool 286sentinalFileExists s = allM R.doesPathExist [sentinalCacheFile s, sentinalFile s] 287 288instance Arbitrary InodeCache where 289 arbitrary = 290 let prim = InodeCachePrim 291 <$> arbitrary 292 <*> arbitrary 293 <*> arbitrary 294 in InodeCache <$> prim 295 296instance Arbitrary MTime where 297 arbitrary = frequency 298 -- timestamp is not usually negative 299 [ (50, MTimeLowRes <$> (abs . fromInteger <$> arbitrary)) 300 , (50, MTimeHighRes <$> arbitrary) 301 ] 302 303#ifdef mingw32_HOST_OS 304instance Arbitrary FileID where 305 arbitrary = fromIntegral <$> (arbitrary :: Gen Word64) 306#endif 307 308prop_read_show_inodecache :: InodeCache -> Bool 309prop_read_show_inodecache c = case readInodeCache (showInodeCache c) of 310 Nothing -> False 311 Just c' -> compareStrong c c' 312