fix for Windows file timestamp timezone madness

On Windows, changing the time zone causes the apparent mtime of files to
change. This confuses git-annex, which natually thinks this means the files
have actually been modified (since THAT'S WHAT A MTIME IS FOR, BILL <sheesh>).

Work around this stupidity, by using the inode sentinal file to detect if
the timezone has changed, and calculate a TSDelta, which will be applied
when generating InodeCaches.

This should add no overhead at all on unix. Indeed, I sped up a few
things slightly in the refactoring.

Seems to basically work! But it has a big known problem:
If the timezone changes while the assistant (or a long-running command)
runs, it won't notice, since it only checks the inode cache once, and
so will use the old delta for all new inode caches it generates for new
files it's added. Which will result in them seeming changed the next time
it runs.

This commit was sponsored by Vincent Demeester.
This commit is contained in:
Joey Hess 2014-06-11 17:51:12 -04:00
parent db8982c45b
commit e4d7e2ebde
6 changed files with 153 additions and 60 deletions

View file

@ -32,10 +32,6 @@ module Annex (
withCurrentState,
) where
import "mtl" Control.Monad.Reader
import Control.Monad.Catch
import Control.Concurrent
import Common
import qualified Git
import qualified Git.Config
@ -62,11 +58,16 @@ import Types.LockPool
import Types.MetaData
import Types.DesktopNotify
import Types.CleanupActions
import qualified Data.Map as M
import qualified Data.Set as S
#ifdef WITH_QUVI
import Utility.Quvi (QuviVersion)
#endif
import Utility.InodeCache
import "mtl" Control.Monad.Reader
import Control.Monad.Catch
import Control.Concurrent
import qualified Data.Map as M
import qualified Data.Set as S
{- git-annex's monad is a ReaderT around an AnnexState stored in a MVar.
- This allows modifying the state in an exception-safe fashion.
@ -120,7 +121,7 @@ data AnnexState = AnnexState
, fields :: M.Map String String
, modmeta :: [ModMeta]
, cleanup :: M.Map CleanupAction (Annex ())
, inodeschanged :: Maybe Bool
, sentinalstatus :: Maybe SentinalStatus
, useragent :: Maybe String
, errcounter :: Integer
, unusedkeys :: Maybe (S.Set Key)
@ -165,7 +166,7 @@ newState c r = AnnexState
, fields = M.empty
, modmeta = []
, cleanup = M.empty
, inodeschanged = Nothing
, sentinalstatus = Nothing
, useragent = Nothing
, errcounter = 0
, unusedkeys = Nothing

View file

@ -1,10 +1,12 @@
{- git-annex file content managing for direct mode
-
- Copyright 2012-2013 Joey Hess <joey@kitenet.net>
- Copyright 2012-2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE CPP #-}
module Annex.Content.Direct (
associatedFiles,
associatedFilesRelative,
@ -27,6 +29,8 @@ module Annex.Content.Direct (
inodesChanged,
createInodeSentinalFile,
addContentWhenNotPresent,
withTSDelta,
getTSDelta,
) where
import Common.Annex
@ -136,7 +140,7 @@ recordedInodeCache key = withInodeCacheFile key $ \f ->
-}
updateInodeCache :: Key -> FilePath -> Annex ()
updateInodeCache key file = maybe noop (addInodeCache key)
=<< liftIO (genInodeCache file)
=<< withTSDelta (liftIO . genInodeCache file)
{- Adds another inode to the cache for a key. -}
addInodeCache :: Key -> InodeCache -> Annex ()
@ -164,16 +168,16 @@ withInodeCacheFile key a = a =<< calcRepo (gitAnnexInodeCache key)
{- Checks if a InodeCache matches the current version of a file. -}
sameInodeCache :: FilePath -> [InodeCache] -> Annex Bool
sameInodeCache _ [] = return False
sameInodeCache file old = go =<< liftIO (genInodeCache file)
sameInodeCache file old = go =<< withTSDelta (liftIO . genInodeCache file)
where
go Nothing = return False
go (Just curr) = elemInodeCaches curr old
{- Checks if a FileStatus matches the recorded InodeCache of a file. -}
sameFileStatus :: Key -> FileStatus -> Annex Bool
sameFileStatus key status = do
sameFileStatus key status = withTSDelta $ \delta -> do
old <- recordedInodeCache key
let curr = toInodeCache status
let curr = toInodeCache delta status
case (old, curr) of
(_, Just c) -> elemInodeCaches c old
([], Nothing) -> return True
@ -217,40 +221,43 @@ addContentWhenNotPresent key contentfile associatedfile = do
- inodes have changed.
-}
inodesChanged :: Annex Bool
inodesChanged = maybe calc return =<< Annex.getState Annex.inodeschanged
inodesChanged = sentinalInodesChanged <$> sentinalStatus
withTSDelta :: (TSDelta -> Annex a) -> Annex a
withTSDelta a = a =<< getTSDelta
getTSDelta :: Annex TSDelta
#ifdef mingw32_HOST_OS
getTSDelta = sentinalTSDelta <$> sentinalStatus
#else
getTSDelta = pure noTSDelta -- optimisation
#endif
sentinalStatus :: Annex SentinalStatus
sentinalStatus = maybe check return =<< Annex.getState Annex.sentinalstatus
where
calc = do
scache <- liftIO . genInodeCache
=<< fromRepo gitAnnexInodeSentinal
scached <- readInodeSentinalFile
let changed = case (scache, scached) of
(Just c1, Just c2) -> not $ compareStrong c1 c2
_ -> True
Annex.changeState $ \s -> s { Annex.inodeschanged = Just changed }
return changed
readInodeSentinalFile :: Annex (Maybe InodeCache)
readInodeSentinalFile = do
sentinalcachefile <- fromRepo gitAnnexInodeSentinalCache
liftIO $ catchDefaultIO Nothing $
readInodeCache <$> readFile sentinalcachefile
writeInodeSentinalFile :: Annex ()
writeInodeSentinalFile = do
sentinalfile <- fromRepo gitAnnexInodeSentinal
createAnnexDirectory (parentDir sentinalfile)
sentinalcachefile <- fromRepo gitAnnexInodeSentinalCache
liftIO $ writeFile sentinalfile ""
liftIO $ maybe noop (writeFile sentinalcachefile . showInodeCache)
=<< genInodeCache sentinalfile
check = do
sc <- liftIO . checkSentinalFile =<< annexSentinalFile
Annex.changeState $ \s -> s { Annex.sentinalstatus = Just sc }
return sc
{- The sentinal file is only created when first initializing a repository.
- If there are any annexed objects in the repository already, creating
- the file would invalidate their inode caches. -}
createInodeSentinalFile :: Annex ()
createInodeSentinalFile =
unlessM (alreadyexists <||> hasobjects)
writeInodeSentinalFile
createInodeSentinalFile = unlessM (alreadyexists <||> hasobjects) $ do
s <- annexSentinalFile
createAnnexDirectory (parentDir (sentinalFile s))
liftIO $ writeSentinalFile s
where
alreadyexists = isJust <$> readInodeSentinalFile
alreadyexists = liftIO. sentinalFileExists =<< annexSentinalFile
hasobjects = liftIO . doesDirectoryExist =<< fromRepo gitAnnexObjectDir
annexSentinalFile :: Annex SentinalFile
annexSentinalFile = do
sentinalfile <- fromRepo gitAnnexInodeSentinal
sentinalcachefile <- fromRepo gitAnnexInodeSentinalCache
return $ SentinalFile
{ sentinalFile = sentinalfile
, sentinalCacheFile = sentinalcachefile
}

View file

@ -53,11 +53,11 @@ stageDirect = do
{- Determine what kind of modified or deleted file this is, as
- efficiently as we can, by getting any key that's associated
- with it in git, as well as its stat info. -}
go (file, Just sha, Just mode) = do
go (file, Just sha, Just mode) = withTSDelta $ \delta -> do
shakey <- catKey sha mode
mstat <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file
filekey <- isAnnexLink file
case (shakey, filekey, mstat, toInodeCache =<< mstat) of
case (shakey, filekey, mstat, toInodeCache delta =<< mstat) of
(_, Just key, _, _)
| shakey == filekey -> noop
{- A changed symlink. -}

View file

@ -313,10 +313,11 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do
adddirect toadd = do
ct <- liftAnnex compareInodeCachesWith
m <- liftAnnex $ removedKeysMap ct cs
delta <- liftAnnex getTSDelta
if M.null m
then forM toadd add
else forM toadd $ \c -> do
mcache <- liftIO $ genInodeCache $ changeFile c
mcache <- liftIO $ genInodeCache (changeFile c) delta
case mcache of
Nothing -> add c
Just cache ->

View file

@ -102,7 +102,7 @@ lockDown = either (\e -> showErr e >> return Nothing) (return . Just) <=< lockDo
lockDown' :: FilePath -> Annex (Either IOException KeySource)
lockDown' file = ifM crippledFileSystem
( liftIO $ tryIO nohardlink
( withTSDelta $ liftIO . tryIO . nohardlink
, tryAnnexIO $ do
tmp <- fromRepo gitAnnexTmpMiscDir
createAnnexDirectory tmp
@ -122,22 +122,22 @@ lockDown' file = ifM crippledFileSystem
go tmp = do
unlessM isDirect $
freezeContent file
liftIO $ do
withTSDelta $ \delta -> liftIO $ do
(tmpfile, h) <- openTempFile tmp $
relatedTemplate $ takeFileName file
hClose h
nukeFile tmpfile
withhardlink tmpfile `catchIO` const nohardlink
nohardlink = do
cache <- genInodeCache file
withhardlink delta tmpfile `catchIO` const (nohardlink delta)
nohardlink delta = do
cache <- genInodeCache file delta
return KeySource
{ keyFilename = file
, contentLocation = file
, inodeCache = cache
}
withhardlink tmpfile = do
withhardlink delta tmpfile = do
createLink file tmpfile
cache <- genInodeCache tmpfile
cache <- genInodeCache tmpfile delta
return KeySource
{ keyFilename = file
, contentLocation = tmpfile
@ -151,11 +151,11 @@ lockDown' file = ifM crippledFileSystem
-}
ingest :: Maybe KeySource -> Annex (Maybe Key, Maybe InodeCache)
ingest Nothing = return (Nothing, Nothing)
ingest (Just source) = do
ingest (Just source) = withTSDelta $ \delta -> do
backend <- chooseBackend $ keyFilename source
k <- genKey source backend
ms <- liftIO $ catchMaybeIO $ getFileStatus $ contentLocation source
let mcache = toInodeCache =<< ms
let mcache = toInodeCache delta =<< ms
case (mcache, inodeCache source) of
(_, Nothing) -> go k mcache ms
(Just newc, Just c) | compareStrong c newc -> go k mcache ms

View file

@ -6,19 +6,33 @@
- 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
@ -32,7 +46,6 @@ data InodeCachePrim = InodeCachePrim FileID FileOffset EpochTime
newtype InodeCache = InodeCache InodeCachePrim
deriving (Show)
{- Inode caches can be compared in two different ways, either weakly
- or strongly. -}
data InodeComparisonType = Weakly | Strongly
@ -92,17 +105,88 @@ readInodeCache s = case words s of
in InodeCache <$> prim
_ -> Nothing
genInodeCache :: FilePath -> IO (Maybe InodeCache)
genInodeCache f = catchDefaultIO Nothing $ toInodeCache <$> getFileStatus f
genInodeCache :: FilePath -> TSDelta -> IO (Maybe InodeCache)
genInodeCache f delta = catchDefaultIO Nothing $
toInodeCache delta <$> getFileStatus f
toInodeCache :: FileStatus -> Maybe InodeCache
toInodeCache s
toInodeCache :: TSDelta -> FileStatus -> Maybe InodeCache
toInodeCache (TSDelta delta) s
| isRegularFile s = Just $ InodeCache $ InodeCachePrim
(fileID s)
(fileSize s)
(modificationTime 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