diff options
| -rw-r--r-- | Annex.hs | 17 | ||||
| -rw-r--r-- | Annex/Content/Direct.hs | 73 | ||||
| -rw-r--r-- | Annex/Direct.hs | 4 | ||||
| -rw-r--r-- | Assistant/Threads/Committer.hs | 3 | ||||
| -rw-r--r-- | Command/Add.hs | 18 | ||||
| -rw-r--r-- | Utility/InodeCache.hs | 96 |
6 files changed, 152 insertions, 59 deletions
@@ -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 diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs index 7a4fba455..2d271eee4 100644 --- a/Annex/Content/Direct.hs +++ b/Annex/Content/Direct.hs @@ -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 - 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 +inodesChanged = sentinalInodesChanged <$> sentinalStatus -readInodeSentinalFile :: Annex (Maybe InodeCache) -readInodeSentinalFile = do - sentinalcachefile <- fromRepo gitAnnexInodeSentinalCache - liftIO $ catchDefaultIO Nothing $ - readInodeCache <$> readFile sentinalcachefile +withTSDelta :: (TSDelta -> Annex a) -> Annex a +withTSDelta a = a =<< getTSDelta -writeInodeSentinalFile :: Annex () -writeInodeSentinalFile = do - sentinalfile <- fromRepo gitAnnexInodeSentinal - createAnnexDirectory (parentDir sentinalfile) - sentinalcachefile <- fromRepo gitAnnexInodeSentinalCache - liftIO $ writeFile sentinalfile "" - liftIO $ maybe noop (writeFile sentinalcachefile . showInodeCache) - =<< genInodeCache sentinalfile +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 + 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 + } diff --git a/Annex/Direct.hs b/Annex/Direct.hs index 70188ea11..e3dbfb6d8 100644 --- a/Annex/Direct.hs +++ b/Annex/Direct.hs @@ -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. -} diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs index cb98b017f..275586343 100644 --- a/Assistant/Threads/Committer.hs +++ b/Assistant/Threads/Committer.hs @@ -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 -> diff --git a/Command/Add.hs b/Command/Add.hs index 46a873151..fc55eb655 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -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 diff --git a/Utility/InodeCache.hs b/Utility/InodeCache.hs index 9bcb6d4f8..b0718e0be 100644 --- a/Utility/InodeCache.hs +++ b/Utility/InodeCache.hs @@ -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 |