diff --git a/Annex/Init.hs b/Annex/Init.hs --- a/Annex/Init.hs +++ b/Annex/Init.hs @@ -109,7 +109,7 @@ setVersion (fromMaybe defaultVersion mversion) configureSmudgeFilter showSideAction "scanning for unlocked files" - scanUnlockedFiles True + scanUnlockedFiles unlessM isBareRepo $ do hookWrite postCheckoutHook hookWrite postMergeHook diff --git a/Annex/WorkTree.hs b/Annex/WorkTree.hs --- a/Annex/WorkTree.hs +++ b/Annex/WorkTree.hs @@ -70,11 +70,12 @@ - when initializing/upgrading a v6+ mode repository. - - Also, the content for the unlocked file may already be present as - - an annex object. If so, make the unlocked file use that content - - when replacefiles is True. + - an annex object. If so, populate the pointer file with it. + - But if worktree file does not have a pointer file's content, it is left + - as-is. -} -scanUnlockedFiles :: Bool -> Annex () -scanUnlockedFiles replacefiles = whenM (inRepo Git.Ref.headExists) $ do +scanUnlockedFiles :: Annex () +scanUnlockedFiles = whenM (inRepo Git.Ref.headExists) $ do Database.Keys.runWriter $ liftIO . Database.Keys.SQL.dropAllAssociatedFiles (l, cleanup) <- inRepo $ Git.LsTree.lsTree Git.LsTree.LsTreeRecursive Git.Ref.headRef @@ -92,15 +93,18 @@ let tf = Git.LsTree.file i Database.Keys.runWriter $ liftIO . Database.Keys.SQL.addAssociatedFileFast (toIKey k) tf - whenM (pure replacefiles <&&> inAnnex k) $ do + whenM (inAnnex k) $ do f <- fromRepo $ fromTopFilePath tf - destmode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus f - ic <- replaceFile f $ \tmp -> - linkFromAnnex k tmp destmode >>= \case - LinkAnnexOk -> - withTSDelta (liftIO . genInodeCache tmp) - LinkAnnexNoop -> return Nothing - LinkAnnexFailed -> liftIO $ do - writePointerFile tmp k destmode - return Nothing - maybe noop (restagePointerFile (Restage True) f) ic + liftIO (isPointerFile f) >>= \case + Just k' | k' == k -> do + destmode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus f + ic <- replaceFile f $ \tmp -> + linkFromAnnex k tmp destmode >>= \case + LinkAnnexOk -> + withTSDelta (liftIO . genInodeCache tmp) + LinkAnnexNoop -> return Nothing + LinkAnnexFailed -> liftIO $ do + writePointerFile tmp k destmode + return Nothing + maybe noop (restagePointerFile (Restage True) f) ic + _ -> noop diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,11 @@ +git-annex (7.20191106) upstream; urgency=medium + + * init: Fix bug that lost modifications to unlocked files when init is + re-ran in an already initialized repo. + * benchmark: Add --databases to benchmark sqlite databases. + + -- Joey Hess Wed, 06 Nov 2019 12:14:50 -0400 + git-annex (7.20191024) upstream; urgency=medium * Changed git add/git commit -a default behavior back to what it was diff --git a/Command/Benchmark.hs b/Command/Benchmark.hs --- a/Command/Benchmark.hs +++ b/Command/Benchmark.hs @@ -11,10 +11,11 @@ import Command import Types.Benchmark - #ifdef WITH_BENCHMARK +import Database.Benchmark + import Criterion.Main -import Criterion.Main.Options (parseWith, Mode) +import Criterion.Main.Options (parseWith) #endif cmd :: BenchmarkGenerator -> Command @@ -23,20 +24,26 @@ paramNothing (seek generator <$$> optParser) -#ifndef WITH_BENCHMARK -type Mode = () -#endif - -data BenchmarkOptions = BenchmarkOptions CmdParams Mode +data BenchmarkOptions + = BenchmarkOptions CmdParams CriterionMode + | BenchmarkDatabases CriterionMode optParser :: CmdParamsDesc -> Parser BenchmarkOptions -optParser desc = BenchmarkOptions - <$> cmdParams desc +optParser desc = benchmarkoptions <|> benchmarkdatabases + where + benchmarkoptions = BenchmarkOptions + <$> cmdParams desc + <*> criterionopts + benchmarkdatabases = BenchmarkDatabases + <$> criterionopts + <* flag' () + ( long "databases" + <> help "benchmark sqlite databases" + ) #ifdef WITH_BENCHMARK - -- parse criterion's options - <*> parseWith defaultConfig + criterionopts = parseWith defaultConfig #else - <*> pure () + criterionopts = pure () #endif seek :: BenchmarkGenerator -> BenchmarkOptions -> CommandSeek @@ -44,6 +51,7 @@ seek generator (BenchmarkOptions ps mode) = do runner <- generator ps liftIO $ runMode mode [ bench (unwords ps) $ nfIO runner ] +seek _ (BenchmarkDatabases mode) = benchmarkDbs mode #else seek _ _ = giveup "git-annex is not built with benchmarking support" #endif diff --git a/Database/Benchmark.hs b/Database/Benchmark.hs new file mode 100644 --- /dev/null +++ b/Database/Benchmark.hs @@ -0,0 +1,120 @@ +{- git-annex database benchmarks + - + - Copyright 2016-2019 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} + +module Database.Benchmark (benchmarkDbs) where + +import Annex.Common +import Types.Benchmark +#ifdef WITH_BENCHMARK +import qualified Database.Keys.SQL as SQL +import qualified Database.Queue as H +import Database.Init +import Database.Types +import Utility.Tmp.Dir +import Git.FilePath +import Types.Key + +import Criterion.Main +import Control.Monad.IO.Class (liftIO) +import qualified Data.ByteString.Char8 as B8 +import System.Random +#endif + +benchmarkDbs :: CriterionMode -> Annex () +#ifdef WITH_BENCHMARK +benchmarkDbs mode = withTmpDirIn "." "benchmark" $ \tmpdir -> do + -- benchmark different sizes of databases + dbs <- mapM (benchDb tmpdir) + [ 1000 + , 10000 + -- , 100000 + ] + liftIO $ runMode mode + [ bgroup "keys database" $ flip concatMap dbs $ \db -> + [ getAssociatedFilesHitBench db + , getAssociatedFilesMissBench db + , getAssociatedKeyHitBench db + , getAssociatedKeyMissBench db + , addAssociatedFileOldBench db + , addAssociatedFileNewBench db + ] + ] +#else +benchmarkDbs _ = error "not built with criterion, cannot benchmark" +#endif + +#ifdef WITH_BENCHMARK + +getAssociatedFilesHitBench :: BenchDb -> Benchmark +getAssociatedFilesHitBench (BenchDb h num) = bench ("getAssociatedFiles from " ++ show num ++ " (hit)") $ nfIO $ do + n <- getStdRandom (randomR (1,num)) + SQL.getAssociatedFiles (toIKey (keyN n)) (SQL.ReadHandle h) + +getAssociatedFilesMissBench :: BenchDb -> Benchmark +getAssociatedFilesMissBench (BenchDb h num) = bench ("getAssociatedFiles from " ++ show num ++ " (miss)") $ nfIO $ + SQL.getAssociatedFiles (toIKey keyMiss) (SQL.ReadHandle h) + +getAssociatedKeyHitBench :: BenchDb -> Benchmark +getAssociatedKeyHitBench (BenchDb h num) = bench ("getAssociatedKey from " ++ show num ++ " (hit)") $ nfIO $ do + n <- getStdRandom (randomR (1,num)) + -- fromIKey because this ends up being used to get a Key + map fromIKey <$> SQL.getAssociatedKey (fileN n) (SQL.ReadHandle h) + +getAssociatedKeyMissBench :: BenchDb -> Benchmark +getAssociatedKeyMissBench (BenchDb h num) = bench ("getAssociatedKey from " ++ show num ++ " (miss)") $ nfIO $ + -- fromIKey because this ends up being used to get a Key + map fromIKey <$> SQL.getAssociatedKey fileMiss (SQL.ReadHandle h) + +addAssociatedFileOldBench :: BenchDb -> Benchmark +addAssociatedFileOldBench (BenchDb h num) = bench ("addAssociatedFile to " ++ show num ++ " (old)") $ nfIO $ do + n <- getStdRandom (randomR (1,num)) + SQL.addAssociatedFile (toIKey (keyN n)) (fileN n) (SQL.WriteHandle h) + H.flushDbQueue h + +addAssociatedFileNewBench :: BenchDb -> Benchmark +addAssociatedFileNewBench (BenchDb h num) = bench ("addAssociatedFile to " ++ show num ++ " (new)") $ nfIO $ do + n <- getStdRandom (randomR (1,num)) + SQL.addAssociatedFile (toIKey (keyN n)) (fileN (n+1)) (SQL.WriteHandle h) + H.flushDbQueue h + +populateAssociatedFiles :: H.DbQueue -> Int -> IO () +populateAssociatedFiles h num = do + forM_ [1..num] $ \n -> + SQL.addAssociatedFile (toIKey (keyN n)) (fileN n) (SQL.WriteHandle h) + H.flushDbQueue h + +keyN :: Int -> Key +keyN n = stubKey + { keyName = B8.pack $ "key" ++ show n + , keyVariety = OtherKey "BENCH" + } + +fileN :: Int -> TopFilePath +fileN n = asTopFilePath ("file" ++ show n) + +keyMiss :: Key +keyMiss = keyN 0 -- 0 is never stored + +fileMiss :: TopFilePath +fileMiss = fileN 0 -- 0 is never stored + +data BenchDb = BenchDb H.DbQueue Int + +benchDb :: FilePath -> Int -> Annex BenchDb +benchDb tmpdir num = do + liftIO $ putStrLn $ "setting up database with " ++ show num + initDb db SQL.createTables + h <- liftIO $ H.openDbQueue H.MultiWriter db SQL.containedTable + liftIO $ populateAssociatedFiles h num + return (BenchDb h num) + where + db = tmpdir show num "db" + +#endif /* WITH_BENCHMARK */ diff --git a/Database/Types.hs b/Database/Types.hs --- a/Database/Types.hs +++ b/Database/Types.hs @@ -17,6 +17,7 @@ import Data.Char import qualified Data.ByteString as S import qualified Data.Text as T +import Control.DeepSeq import Utility.PartialPrelude import Key @@ -40,6 +41,9 @@ -- A Key index. More efficient than SKey, but its Read instance does not -- work when it's used in any kind of complex data structure. newtype IKey = IKey String + +instance NFData IKey where + rnf (IKey s) = rnf s instance Read IKey where readsPrec _ s = [(IKey s, "")] diff --git a/Git/FilePath.hs b/Git/FilePath.hs --- a/Git/FilePath.hs +++ b/Git/FilePath.hs @@ -11,6 +11,7 @@ -} {-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} module Git.FilePath ( TopFilePath, @@ -30,10 +31,14 @@ import Git import qualified System.FilePath.Posix +import GHC.Generics +import Control.DeepSeq {- A FilePath, relative to the top of the git repository. -} newtype TopFilePath = TopFilePath { getTopFilePath :: FilePath } - deriving (Show, Eq, Ord) + deriving (Show, Eq, Ord, Generic) + +instance NFData TopFilePath {- A file in a branch or other treeish. -} data BranchFilePath = BranchFilePath Ref TopFilePath diff --git a/Types/Benchmark.hs b/Types/Benchmark.hs --- a/Types/Benchmark.hs +++ b/Types/Benchmark.hs @@ -5,11 +5,22 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE CPP #-} + module Types.Benchmark where import Annex import Types.Command +#ifdef WITH_BENCHMARK +import Criterion.Main.Options (Mode) +#endif type BenchmarkGenerator = [String] -> Annex (IO ()) type MkBenchmarkGenerator = [Command] -> BenchmarkGenerator + +#ifdef WITH_BENCHMARK +type CriterionMode = Mode +#else +type CriterionMode = () +#endif diff --git a/Types/Key.hs b/Types/Key.hs --- a/Types/Key.hs +++ b/Types/Key.hs @@ -5,7 +5,7 @@ - Licensed under the GNU AGPL version 3 or higher. -} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, DeriveGeneric #-} module Types.Key where @@ -13,6 +13,8 @@ import qualified Data.ByteString.Char8 as S8 import System.Posix.Types import Data.Monoid +import GHC.Generics +import Control.DeepSeq import Prelude {- A Key has a unique name, which is derived from a particular backend, @@ -24,8 +26,10 @@ , keyMtime :: Maybe EpochTime , keyChunkSize :: Maybe Integer , keyChunkNum :: Maybe Integer - } deriving (Eq, Ord, Read, Show) + } deriving (Eq, Ord, Read, Show, Generic) +instance NFData Key + {- A filename may be associated with a Key. -} newtype AssociatedFile = AssociatedFile (Maybe FilePath) deriving (Show, Eq, Ord) @@ -46,15 +50,21 @@ -- Some repositories may contain keys of other varieties, -- which can still be processed to some extent. | OtherKey S.ByteString - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show, Generic) +instance NFData KeyVariety + {- Some varieties of keys may contain an extension at the end of the - keyName -} newtype HasExt = HasExt Bool - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show, Generic) +instance NFData HasExt + newtype HashSize = HashSize Int - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show, Generic) + +instance NFData HashSize hasExt :: KeyVariety -> Bool hasExt (SHA2Key _ (HasExt b)) = b diff --git a/Upgrade/V5.hs b/Upgrade/V5.hs --- a/Upgrade/V5.hs +++ b/Upgrade/V5.hs @@ -42,13 +42,10 @@ ( do checkGitVersionForDirectUpgrade convertDirect - -- Worktree files are already populated, so don't - -- have this try to populate them again. - scanUnlockedFiles False , do checkGitVersionForIndirectUpgrade - scanUnlockedFiles True ) + scanUnlockedFiles configureSmudgeFilter -- Inode sentinal file was only used in direct mode and when -- locking down files as they were added. In v6, it's used more diff --git a/git-annex.cabal b/git-annex.cabal --- a/git-annex.cabal +++ b/git-annex.cabal @@ -1,5 +1,5 @@ Name: git-annex -Version: 7.20191024 +Version: 7.20191106 Cabal-Version: >= 1.8 License: AGPL-3 Maintainer: Joey Hess @@ -813,6 +813,7 @@ Config.Smudge Creds Crypto + Database.Benchmark Database.ContentIdentifier Database.Export Database.Fsck