summaryrefslogtreecommitdiff
path: root/git-repair.hs
blob: 797dec33d308b44814ade4151a72895ba5f28e98 (plain)
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
{- git-repair program
 -
 - Copyright 2013 Joey Hess <joey@kitenet.net>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

import Options.Applicative

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
parseSettings = Settings
	<$> switch
		( 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 >>= 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
	g <- Git.Config.read =<< Git.CurrentRepo.get
	ifM (Git.Repair.successfulRepair <$> Git.Repair.runRepair (forced settings) g)
		( 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"