1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
|
{- Caching a file's inode, size, and modification time
- to see when it's changed.
-
- Copyright 2013, 2014 Joey Hess <joey@kitenet.net>
-
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Utility.InodeCache (
InodeCache,
InodeComparisonType(..),
compareStrong,
compareWeak,
compareBy,
readInodeCache,
showInodeCache,
genInodeCache,
toInodeCache,
InodeCacheKey,
inodeCacheToKey,
inodeCacheToMtime,
SentinalFile(..),
SentinalStatus(..),
TSDelta,
noTSDelta,
writeSentinalFile,
checkSentinalFile,
sentinalFileExists,
prop_read_show_inodecache
) where
import Common
import System.PosixCompat.Types
import Utility.QuickCheck
#ifdef mingw32_HOST_OS
import Data.Word (Word64)
#endif
data InodeCachePrim = InodeCachePrim FileID Integer EpochTime
deriving (Show, Eq, Ord)
newtype InodeCache = InodeCache InodeCachePrim
deriving (Show)
{- Inode caches can be compared in two different ways, either weakly
- or strongly. -}
data InodeComparisonType = Weakly | Strongly
deriving (Eq, Ord)
{- 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-anther as the same. This is because FAT has only a 2 second
- resolution. When a FAT filesystem is used on Linux, higher resolution
- timestamps are cached and used by Linux, but this is 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 (mtime1 - 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)
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
inodeCacheToMtime :: InodeCache -> EpochTime
inodeCacheToMtime (InodeCache (InodeCachePrim _ _ mtime)) = mtime
showInodeCache :: InodeCache -> String
showInodeCache (InodeCache (InodeCachePrim inode size mtime)) = unwords
[ show inode
, show size
, show mtime
]
readInodeCache :: String -> Maybe InodeCache
readInodeCache s = case words s of
(inode:size:mtime:_) ->
let prim = InodeCachePrim
<$> readish inode
<*> readish size
<*> readish mtime
in InodeCache <$> prim
_ -> Nothing
genInodeCache :: FilePath -> TSDelta -> IO (Maybe InodeCache)
genInodeCache f delta = catchDefaultIO Nothing $
toInodeCache delta f =<< getFileStatus f
toInodeCache :: TSDelta -> FilePath -> FileStatus -> IO (Maybe InodeCache)
toInodeCache (TSDelta getdelta) f s
| isRegularFile s = do
delta <- getdelta
sz <- getFileSize' f s
return $ Just $ InodeCache $ InodeCachePrim
(fileID s)
sz
(modificationTime s + 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 :: FilePath
, sentinalCacheFile :: FilePath
}
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 (sentinalFile s) ""
maybe noop (writeFile (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 canot 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 (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)) ->
oldmtime - 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 doesFileExist [sentinalCacheFile s, sentinalFile s]
instance Arbitrary InodeCache where
arbitrary =
let prim = InodeCachePrim
<$> arbitrary
<*> arbitrary
<*> arbitrary
in InodeCache <$> prim
#ifdef mingw32_HOST_OS
instance Arbitrary FileID where
arbitrary = fromIntegral <$> (arbitrary :: Gen Word64)
#endif
prop_read_show_inodecache :: InodeCache -> Bool
prop_read_show_inodecache c = case readInodeCache (showInodeCache c) of
Nothing -> False
Just c' -> compareStrong c c'
|
