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
|
{- 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 #-}
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
data InodeCachePrim = InodeCachePrim FileID FileOffset 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 <$> getFileStatus f
toInodeCache :: TSDelta -> FileStatus -> Maybe InodeCache
toInodeCache (TSDelta delta) s
| isRegularFile s = Just $ InodeCache $ InodeCachePrim
(fileID s)
(fileSize s)
(modificationTime s + delta)
| otherwise = 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. -}
newtype TSDelta = TSDelta EpochTime
deriving (Show)
noTSDelta :: TSDelta
noTSDelta = TSDelta 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
}
deriving (Show)
{- Checks if the InodeCache of the sentinal file is the same
- as it was when it was originally created.
-
- On Windows, there's no change even when there is a nonzero
- TSDelta between the original and current InodeCaches.
-
- If the sential does not exist, returns a dummy value indicating
- that it's apparently changed.
-}
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 inode1 size1 mtime1)) (InodeCache (InodeCachePrim inode2 size2 mtime2)) =
SentinalStatus (not unchanged) tsdelta
where
#ifdef mingw32_HOST_OS
unchanged = inode1 == inode2 && size1 == size2
tsdelta = TSDelta (mtime1 - mtime2)
#else
unchanged = inode1 == inode2 && size1 == size2 && mtime1 == mtime2
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
prop_read_show_inodecache :: InodeCache -> Bool
prop_read_show_inodecache c = case readInodeCache (showInodeCache c) of
Nothing -> False
Just c' -> compareStrong c c'
|
