summaryrefslogtreecommitdiff
path: root/git-repair.hs
diff options
context:
space:
mode:
authorJoey Hess <joey@kitenet.net>2013-11-21 02:20:19 -0400
committerJoey Hess <joey@kitenet.net>2013-11-21 02:20:19 -0400
commite38c59dfde89f15c61b4073dcd19b53dfe440e74 (patch)
tree1f6d32f1b125f4c21232eb8c63748572f59c4c7a /git-repair.hs
parent897f030f68ff847c03494fbdd4104d1f8dfad9fe (diff)
downloadgit-repair-e38c59dfde89f15c61b4073dcd19b53dfe440e74.tar.gz
combine test program into git-repair
Diffstat (limited to 'git-repair.hs')
-rw-r--r--git-repair.hs97
1 files changed, 96 insertions, 1 deletions
diff --git a/git-repair.hs b/git-repair.hs
index ce1444f..797dec3 100644
--- a/git-repair.hs
+++ b/git-repair.hs
@@ -11,9 +11,16 @@ import Common
import qualified Git.CurrentRepo
import qualified Git.Repair
import qualified Git.Config
+import qualified Git.Construct
+import qualified Git.Destroyer
+import qualified Git.Fsck
+import Utility.Tmp
data Settings = Settings
{ forced :: Bool
+ , testMode :: Bool
+ , retryTestMode :: Bool
+ , numTests :: Int
}
parseSettings :: Parser Settings
@@ -22,13 +29,32 @@ parseSettings = Settings
( long "force"
<> help "Force repair, even if data is lost"
)
+ <*> switch
+ ( long "test"
+ <> help "Clone local repo, damage the clone, and test repair"
+ )
+ <*> switch
+ ( long "retry"
+ <> help "Retry tests in git-repair-test.log"
+ )
+ <*> option
+ ( long "numtests"
+ <> short 'n'
+ <> metavar "N"
+ <> help "Run N tests"
+ <> value 1
+ )
main :: IO ()
-main = execParser opts >>= repair
+main = execParser opts >>= go
where
opts = info (helper <*> parseSettings) desc
desc = fullDesc
<> header "git-repair - repair a damanged git repository"
+ go settings
+ | testModeĀ settings = test settings
+ | retryTestMode settings = retryTest settings
+ | otherwise = repair settings
repair :: Settings -> IO ()
repair settings = do
@@ -37,3 +63,72 @@ repair settings = do
( exitSuccess
, exitFailure
)
+
+test :: Settings -> IO ()
+test settings = do
+ forM_ [1 .. numTests settings] $ \n -> do
+ putStrLn $ "** Test " ++ show n ++ "/" ++ show (numTests settings)
+ damage <- Git.Destroyer.generateDamage
+ logDamage damage
+ runTest settings damage >>= handleTestResult
+ allOk
+
+retryTest :: Settings -> IO ()
+retryTest settings = do
+ l <- map Prelude.read . lines <$> readFile logFile
+ forM_ l $ \damage ->
+ runTest settings damage >>= handleTestResult
+ allOk
+
+runTest :: Settings -> [Git.Destroyer.Damage] -> IO TestResult
+runTest settings damage = withTmpDir "tmprepo" $ \tmpdir -> do
+ let cloneloc = tmpdir </> "clone"
+ cloned <- boolSystem "git"
+ [ Param "clone"
+ , Param "--no-hardlinks"
+ , File "."
+ , File cloneloc
+ ]
+ unless cloned $
+ error $ "failed to clone this repo"
+ g <- Git.Config.read =<< Git.Construct.fromPath cloneloc
+ Git.Destroyer.applyDamage damage g
+ repairstatus <- catchMaybeIO $ Git.Repair.successfulRepair
+ <$> Git.Repair.runRepair (forced settings) g
+ case repairstatus of
+ Just True -> TestResult repairstatus
+ . Just . not . Git.Fsck.foundBroken
+ <$> Git.Fsck.findBroken False g
+ _ -> return $ TestResult repairstatus Nothing
+
+data TestResult = TestResult
+ { repairResult :: Maybe Bool
+ , fsckResult :: Maybe Bool
+ }
+ deriving (Read, Show)
+
+handleTestResult :: TestResult -> IO ()
+handleTestResult testresult = do
+ ok <- case (repairResult testresult, fsckResult testresult) of
+ (Just True, Just True) -> do
+ putStrLn "** repair succeeded"
+ return True
+ (Just True, Just False) -> do
+ putStrLn "** repair succeeded, but final fsck failed"
+ return False
+ _ -> do
+ putStrLn "** repair failed"
+ return False
+ unless ok $
+ exitFailure
+
+allOk :: IO ()
+allOk = do
+ putStrLn ""
+ putStrLn "All tests ok!"
+
+logDamage :: [Git.Destroyer.Damage] -> IO ()
+logDamage damage = appendFile logFile $ show damage ++ "\n"
+
+logFile :: FilePath
+logFile = "git-repair-test.log"