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