1{- git repository recovery
2 -
3 - Copyright 2013-2021 Joey Hess <id@joeyh.name>
4 -
5 - Licensed under the GNU AGPL version 3 or higher.
6 -}
7
8{-# LANGUAGE OverloadedStrings #-}
9
10module Git.Repair (
11	runRepair,
12	runRepairOf,
13	removeBadBranches,
14	successfulRepair,
15	cleanCorruptObjects,
16	resetLocalBranches,
17	checkIndex,
18	checkIndexFast,
19	missingIndex,
20	emptyGoodCommits,
21	isTrackingBranch,
22) where
23
24import Common
25import Git
26import Git.Command
27import Git.Objects
28import Git.Sha
29import Git.Types
30import Git.Fsck
31import Git.Index
32import Git.Env
33import qualified Git.Config as Config
34import qualified Git.Construct as Construct
35import qualified Git.LsTree as LsTree
36import qualified Git.LsFiles as LsFiles
37import qualified Git.Ref as Ref
38import qualified Git.RefLog as RefLog
39import qualified Git.UpdateIndex as UpdateIndex
40import qualified Git.Branch as Branch
41import Utility.Directory.Create
42import Utility.Tmp.Dir
43import Utility.Rsync
44import Utility.FileMode
45import qualified Utility.RawFilePath as R
46
47import qualified Data.Set as S
48import qualified Data.ByteString.Lazy as L
49import qualified System.FilePath.ByteString as P
50
51{- Given a set of bad objects found by git fsck, which may not
52 - be complete, finds and removes all corrupt objects. -}
53cleanCorruptObjects :: FsckResults -> Repo -> IO ()
54cleanCorruptObjects fsckresults r = do
55	void $ explodePacks r
56	mapM_ removeLoose (S.toList $ knownMissing fsckresults)
57	mapM_ removeBad =<< listLooseObjectShas r
58  where
59	removeLoose s = removeWhenExistsWith R.removeLink (looseObjectFile r s)
60	removeBad s = do
61		void $ tryIO $ allowRead $ looseObjectFile r s
62		whenM (isMissing s r) $
63			removeLoose s
64
65{- Explodes all pack files to loose objects, and deletes the pack files.
66 -
67 - git unpack-objects will not unpack objects from a pack file that are
68 - in the git repo. So, GIT_OBJECT_DIRECTORY is pointed to a temporary
69 - directory, and the loose objects then are moved into place, before
70 - deleting the pack files.
71 -
72 - Also, that prevents unpack-objects from possibly looking at corrupt
73 - pack files to see if they contain an object, while unpacking a
74 - non-corrupt pack file.
75 -}
76explodePacks :: Repo -> IO Bool
77explodePacks r = go =<< listPackFiles r
78  where
79	go [] = return False
80	go packs = withTmpDir "packs" $ \tmpdir -> do
81		r' <- addGitEnv r "GIT_OBJECT_DIRECTORY" tmpdir
82		putStrLn "Unpacking all pack files."
83		forM_ packs $ \packfile -> do
84			-- Just in case permissions are messed up.
85			allowRead (toRawFilePath packfile)
86			-- May fail, if pack file is corrupt.
87			void $ tryIO $
88				pipeWrite [Param "unpack-objects", Param "-r"] r' $ \h ->
89				L.hPut h =<< L.readFile packfile
90		objs <- dirContentsRecursive tmpdir
91		forM_ objs $ \objfile -> do
92			f <- relPathDirToFile
93				(toRawFilePath tmpdir)
94				(toRawFilePath objfile)
95			let dest = objectsDir r P.</> f
96			createDirectoryIfMissing True
97				(fromRawFilePath (parentDir dest))
98			moveFile objfile (fromRawFilePath dest)
99		forM_ packs $ \packfile -> do
100			let f = toRawFilePath packfile
101			removeWhenExistsWith R.removeLink f
102			removeWhenExistsWith R.removeLink (packIdxFile f)
103		return True
104
105{- Try to retrieve a set of missing objects, from the remotes of a
106 - repository. Returns any that could not be retreived.
107 -
108 - If another clone of the repository exists locally, which might not be a
109 - remote of the repo being repaired, its path can be passed as a reference
110 - repository.
111 -}
112retrieveMissingObjects :: FsckResults -> Maybe FilePath -> Repo -> IO FsckResults
113retrieveMissingObjects missing referencerepo r
114	| not (foundBroken missing) = return missing
115	| otherwise = withTmpDir "tmprepo" $ \tmpdir -> do
116		unlessM (boolSystem "git" [Param "init", File tmpdir]) $
117			error $ "failed to create temp repository in " ++ tmpdir
118		tmpr <- Config.read =<< Construct.fromPath (toRawFilePath tmpdir)
119		let repoconfig r' = fromRawFilePath (localGitDir r' P.</> "config")
120		whenM (doesFileExist (repoconfig r)) $
121			L.readFile (repoconfig r) >>= L.writeFile (repoconfig tmpr)
122		rs <- Construct.fromRemotes r
123		stillmissing <- pullremotes tmpr rs fetchrefstags missing
124		if S.null (knownMissing stillmissing)
125			then return stillmissing
126			else pullremotes tmpr rs fetchallrefs stillmissing
127  where
128	pullremotes tmpr [] fetchrefs stillmissing = case referencerepo of
129		Nothing -> return stillmissing
130		Just p -> ifM (fetchfrom p fetchrefs tmpr)
131			( do
132				void $ explodePacks tmpr
133				void $ copyObjects tmpr r
134				case stillmissing of
135					FsckFailed -> return $ FsckFailed
136					FsckFoundMissing s t -> FsckFoundMissing
137						<$> findMissing (S.toList s) r
138						<*> pure t
139			, return stillmissing
140			)
141	pullremotes tmpr (rmt:rmts) fetchrefs ms
142		| not (foundBroken ms) = return ms
143		| otherwise = case remoteName rmt of
144			Just n -> do
145				putStrLn $ "Trying to recover missing objects from remote " ++ n ++ "."
146				ifM (fetchfrom n fetchrefs tmpr)
147					( do
148						void $ explodePacks tmpr
149						void $ copyObjects tmpr r
150						case ms of
151							FsckFailed -> pullremotes tmpr rmts fetchrefs ms
152							FsckFoundMissing s t -> do
153								stillmissing <- findMissing (S.toList s) r
154								pullremotes tmpr rmts fetchrefs (FsckFoundMissing stillmissing t)
155					, pullremotes tmpr rmts fetchrefs ms
156					)
157			Nothing -> pullremotes tmpr rmts fetchrefs ms
158	fetchfrom loc ps fetchr = runBool ps' fetchr'
159	  where
160		ps' =
161			[ Param "fetch"
162			, Param loc
163			, Param "--force"
164			, Param "--update-head-ok"
165			, Param "--quiet"
166			] ++ ps
167		fetchr' = fetchr { gitGlobalOpts = gitGlobalOpts fetchr ++ nogc }
168		nogc = [ Param "-c", Param "gc.auto=0" ]
169
170	-- fetch refs and tags
171	fetchrefstags = [ Param "+refs/heads/*:refs/heads/*", Param "--tags"]
172	-- Fetch all available refs (more likely to fail,
173	-- as the remote may have refs it refuses to send).
174	fetchallrefs = [ Param "+*:*" ]
175
176{- Copies all objects from the src repository to the dest repository.
177 - This is done using rsync, so it copies all missing objects, and all
178 - objects they rely on. -}
179copyObjects :: Repo -> Repo -> IO Bool
180copyObjects srcr destr = rsync
181	[ Param "-qr"
182	, File $ addTrailingPathSeparator $ fromRawFilePath $ objectsDir srcr
183	, File $ addTrailingPathSeparator $ fromRawFilePath $ objectsDir destr
184	]
185
186{- To deal with missing objects that cannot be recovered, resets any
187 - local branches to point to an old commit before the missing
188 - objects. Returns all branches that were changed, and deleted.
189 -}
190resetLocalBranches :: MissingObjects -> GoodCommits -> Repo -> IO ([Branch], [Branch], GoodCommits)
191resetLocalBranches missing goodcommits r =
192	go [] [] goodcommits =<< filter islocalbranch <$> getAllRefs r
193  where
194	islocalbranch b = "refs/heads/" `isPrefixOf` fromRef b
195	go changed deleted gcs [] = return (changed, deleted, gcs)
196	go changed deleted gcs (b:bs) = do
197		(mc, gcs') <- findUncorruptedCommit missing gcs b r
198		case mc of
199			Just c
200				| c == b -> go changed deleted gcs' bs
201				| otherwise -> do
202					reset b c
203					go (b:changed) deleted gcs' bs
204			Nothing -> do
205				nukeBranchRef b r
206				go changed (b:deleted) gcs' bs
207	reset b c = do
208		nukeBranchRef b	r
209		void $ runBool
210			[ Param "branch"
211			, Param (fromRef $ Ref.base b)
212			, Param (fromRef c)
213			] r
214
215isTrackingBranch :: Ref -> Bool
216isTrackingBranch b = "refs/remotes/" `isPrefixOf` fromRef b
217
218{- To deal with missing objects that cannot be recovered, removes
219 - any branches (filtered by a predicate) that reference them
220 - Returns a list of all removed branches.
221 -}
222removeBadBranches :: (Ref -> Bool) -> Repo -> IO [Branch]
223removeBadBranches removablebranch r = fst <$> removeBadBranches' removablebranch S.empty emptyGoodCommits r
224
225removeBadBranches' :: (Ref -> Bool) -> MissingObjects -> GoodCommits -> Repo -> IO ([Branch], GoodCommits)
226removeBadBranches' removablebranch missing goodcommits r =
227	go [] goodcommits =<< filter removablebranch <$> getAllRefs r
228  where
229	go removed gcs [] = return (removed, gcs)
230	go removed gcs (b:bs) = do
231		(ok, gcs') <- verifyCommit missing gcs b r
232		if ok
233			then go removed gcs' bs
234			else do
235				nukeBranchRef b r
236				go (b:removed) gcs' bs
237
238badBranches :: MissingObjects -> Repo -> IO [Branch]
239badBranches missing r = filterM isbad =<< getAllRefs r
240  where
241	isbad b = not . fst <$> verifyCommit missing emptyGoodCommits b r
242
243{- Gets all refs, including ones that are corrupt.
244 - git show-ref does not output refs to commits that are directly
245 - corrupted, so it is not used.
246 -
247 - Relies on packed refs being exploded before it's called.
248 -}
249getAllRefs :: Repo -> IO [Ref]
250getAllRefs r = getAllRefs' (fromRawFilePath (localGitDir r) </> "refs")
251
252getAllRefs' :: FilePath -> IO [Ref]
253getAllRefs' refdir = do
254	let topsegs = length (splitPath refdir) - 1
255	let toref = Ref . encodeBS . joinPath . drop topsegs . splitPath
256	map toref <$> dirContentsRecursive refdir
257
258explodePackedRefsFile :: Repo -> IO ()
259explodePackedRefsFile r = do
260	let f = packedRefsFile r
261	let f' = toRawFilePath f
262	whenM (doesFileExist f) $ do
263		rs <- mapMaybe parsePacked . lines
264			<$> catchDefaultIO "" (safeReadFile f')
265		forM_ rs makeref
266		removeWhenExistsWith R.removeLink f'
267  where
268	makeref (sha, ref) = do
269		let gitd = localGitDir r
270		let dest = gitd P.</> fromRef' ref
271		let dest' = fromRawFilePath dest
272		createDirectoryUnder gitd (parentDir dest)
273		unlessM (doesFileExist dest') $
274			writeFile dest' (fromRef sha)
275
276packedRefsFile :: Repo -> FilePath
277packedRefsFile r = fromRawFilePath (localGitDir r) </> "packed-refs"
278
279parsePacked :: String -> Maybe (Sha, Ref)
280parsePacked l = case words l of
281	(sha:ref:[])
282		| isJust (extractSha (encodeBS sha)) && Ref.legal True ref ->
283			Just (Ref (encodeBS sha), Ref (encodeBS ref))
284	_ -> Nothing
285
286{- git-branch -d cannot be used to remove a branch that is directly
287 - pointing to a corrupt commit. -}
288nukeBranchRef :: Branch -> Repo -> IO ()
289nukeBranchRef b r = removeWhenExistsWith R.removeLink $ localGitDir r P.</> fromRef' b
290
291{- Finds the most recent commit to a branch that does not need any
292 - of the missing objects. If the input branch is good as-is, returns it.
293 - Otherwise, tries to traverse the commits in the branch to find one
294 - that is ok. That might fail, if one of them is corrupt, or if an object
295 - at the root of the branch is missing. Finally, looks for an old version
296 - of the branch from the reflog.
297 -}
298findUncorruptedCommit :: MissingObjects -> GoodCommits -> Branch -> Repo -> IO (Maybe Sha, GoodCommits)
299findUncorruptedCommit missing goodcommits branch r = do
300	(ok, goodcommits') <- verifyCommit missing goodcommits branch r
301	if ok
302		then return (Just branch, goodcommits')
303		else do
304			(ls, cleanup) <- pipeNullSplit'
305				[ Param "log"
306				, Param "-z"
307				, Param "--format=%H"
308				, Param (fromRef branch)
309				] r
310			let branchshas = catMaybes $ map extractSha ls
311			reflogshas <- RefLog.get branch r
312			-- XXX Could try a bit harder here, and look
313			-- for uncorrupted old commits in branches in the
314			-- reflog.
315			cleanup `after` findfirst goodcommits (branchshas ++ reflogshas)
316  where
317	findfirst gcs [] = return (Nothing, gcs)
318	findfirst gcs (c:cs) = do
319		(ok, gcs') <- verifyCommit missing gcs c r
320		if ok
321			then return (Just c, gcs')
322			else findfirst gcs' cs
323
324{- Verifies that none of the missing objects in the set are used by
325 - the commit. Also adds to a set of commit shas that have been verified to
326 - be good, which can be passed into subsequent calls to avoid
327 - redundant work when eg, chasing down branches to find the first
328 - uncorrupted commit. -}
329verifyCommit :: MissingObjects -> GoodCommits -> Sha -> Repo -> IO (Bool, GoodCommits)
330verifyCommit missing goodcommits commit r
331	| checkGoodCommit commit goodcommits = return (True, goodcommits)
332	| otherwise = do
333		(ls, cleanup) <- pipeNullSplit
334			[ Param "log"
335			, Param "-z"
336			, Param "--format=%H %T"
337			, Param (fromRef commit)
338			] r
339		let committrees = map (parse . decodeBL) ls
340		if any isNothing committrees || null committrees
341			then do
342				void cleanup
343				return (False, goodcommits)
344			else do
345				let cts = catMaybes committrees
346				ifM (cleanup <&&> check cts)
347					( return (True, addGoodCommits (map fst cts) goodcommits)
348					, return (False, goodcommits)
349					)
350  where
351	parse l = case words l of
352		(commitsha:treesha:[]) -> (,)
353			<$> extractSha (encodeBS commitsha)
354			<*> extractSha (encodeBS treesha)
355		_ -> Nothing
356	check [] = return True
357	check ((c, t):rest)
358		| checkGoodCommit c goodcommits = return True
359		| otherwise = verifyTree missing t r <&&> check rest
360
361{- Verifies that a tree is good, including all trees and blobs
362 - referenced by it. -}
363verifyTree :: MissingObjects -> Sha -> Repo -> IO Bool
364verifyTree missing treesha r
365	| S.member treesha missing = return False
366	| otherwise = do
367		let nolong = LsTree.LsTreeLong False
368		(ls, cleanup) <- pipeNullSplit (LsTree.lsTreeParams LsTree.LsTreeRecursive nolong treesha []) r
369		let objshas = mapMaybe (LsTree.sha <$$> eitherToMaybe . LsTree.parseLsTree nolong) ls
370		if any (`S.member` missing) objshas
371			then do
372				void cleanup
373				return False
374			-- as long as ls-tree succeeded, we're good
375			else cleanup
376
377{- Checks that the index file only refers to objects that are not missing,
378 - and is not itself corrupt. Note that a missing index file is not
379 - considered a problem (repo may be new). -}
380checkIndex :: Repo -> IO Bool
381checkIndex r = do
382	(bad, _good, cleanup) <- partitionIndex r
383	if null bad
384		then cleanup
385		else do
386			void cleanup
387			return False
388
389{- Does not check every object the index refers to, but only that the index
390 - itself is not corrupt. -}
391checkIndexFast :: Repo -> IO Bool
392checkIndexFast r = do
393	(indexcontents, cleanup) <- LsFiles.stagedDetails [repoPath r] r
394	length indexcontents `seq` cleanup
395
396missingIndex :: Repo -> IO Bool
397missingIndex r = not <$> doesFileExist (fromRawFilePath (localGitDir r) </> "index")
398
399{- Finds missing and ok files staged in the index. -}
400partitionIndex :: Repo -> IO ([LsFiles.StagedDetails], [LsFiles.StagedDetails], IO Bool)
401partitionIndex r = do
402	(indexcontents, cleanup) <- LsFiles.stagedDetails [repoPath r] r
403	l <- forM indexcontents $ \i@(_file, sha, _mode, _stagenum) ->
404		(,) <$> isMissing sha r <*> pure i
405	let (bad, good) = partition fst l
406	return (map snd bad, map snd good, cleanup)
407
408{- Rewrites the index file, removing from it any files whose blobs are
409 - missing. Returns the list of affected files. -}
410rewriteIndex :: Repo -> IO [FilePath]
411rewriteIndex r
412	| repoIsLocalBare r = return []
413	| otherwise = do
414		(bad, good, cleanup) <- partitionIndex r
415		unless (null bad) $ do
416			removeWhenExistsWith R.removeLink (indexFile r)
417			UpdateIndex.streamUpdateIndex r
418				=<< (catMaybes <$> mapM reinject good)
419		void cleanup
420		return $ map (\(file,_, _, _) -> fromRawFilePath file) bad
421  where
422	reinject (file, sha, mode, _) = case toTreeItemType mode of
423		Nothing -> return Nothing
424		Just treeitemtype -> Just <$>
425			UpdateIndex.stageFile sha treeitemtype (fromRawFilePath file) r
426
427newtype GoodCommits = GoodCommits (S.Set Sha)
428
429emptyGoodCommits :: GoodCommits
430emptyGoodCommits = GoodCommits S.empty
431
432checkGoodCommit :: Sha -> GoodCommits -> Bool
433checkGoodCommit sha (GoodCommits s) = S.member sha s
434
435addGoodCommits :: [Sha] -> GoodCommits -> GoodCommits
436addGoodCommits shas (GoodCommits s) = GoodCommits $
437	S.union s (S.fromList shas)
438
439displayList :: [String] -> String -> IO ()
440displayList items header
441	| null items = return ()
442	| otherwise = do
443		putStrLn header
444		putStr $ unlines $ map (\i -> "\t" ++ i) truncateditems
445  where
446	numitems = length items
447	truncateditems
448		| numitems > 10 = take 10 items ++ ["(and " ++ show (numitems - 10) ++ " more)"]
449		| otherwise = items
450
451{- Fix problems that would prevent repair from working at all
452 -
453 - A missing or corrupt .git/HEAD makes git not treat the repository as a
454 - git repo. If there is a git repo in a parent directory, it may move up
455 - the tree and use that one instead. So, cannot use `git show-ref HEAD` to
456 - test it.
457 -
458 - Explode the packed refs file, to simplify dealing with refs, and because
459 - fsck can complain about bad refs in it.
460 -}
461preRepair :: Repo -> IO ()
462preRepair g = do
463	unlessM (validhead <$> catchDefaultIO "" (safeReadFile headfile)) $ do
464		removeWhenExistsWith R.removeLink headfile
465		writeFile (fromRawFilePath headfile) "ref: refs/heads/master"
466	explodePackedRefsFile g
467	unless (repoIsLocalBare g) $
468		void $ tryIO $ allowWrite $ indexFile g
469  where
470	headfile = localGitDir g P.</> "HEAD"
471	validhead s = "ref: refs/" `isPrefixOf` s
472		|| isJust (extractSha (encodeBS s))
473
474{- Put it all together. -}
475runRepair :: (Ref -> Bool) -> Bool -> Repo -> IO (Bool, [Branch])
476runRepair removablebranch forced g = do
477	preRepair g
478	putStrLn "Running git fsck ..."
479	fsckresult <- findBroken False False g
480	if foundBroken fsckresult
481		then do
482			putStrLn "Fsck found problems, attempting repair."
483			runRepair' removablebranch fsckresult forced Nothing g
484		else do
485			putStrLn "Fsck found no problems. Checking for broken branches."
486			bad <- badBranches S.empty g
487			if null bad
488				then do
489					putStrLn "No problems found."
490					return (True, [])
491				else do
492					putStrLn "Found problems, attempting repair."
493					runRepair' removablebranch fsckresult forced Nothing g
494
495runRepairOf :: FsckResults -> (Ref -> Bool) -> Bool -> Maybe FilePath -> Repo -> IO (Bool, [Branch])
496runRepairOf fsckresult removablebranch forced referencerepo g = do
497	preRepair g
498	runRepair' removablebranch fsckresult forced referencerepo g
499
500runRepair' :: (Ref -> Bool) -> FsckResults -> Bool -> Maybe FilePath -> Repo -> IO (Bool, [Branch])
501runRepair' removablebranch fsckresult forced referencerepo g = do
502	cleanCorruptObjects fsckresult g
503	missing <- findBroken False False g
504	stillmissing <- retrieveMissingObjects missing referencerepo g
505	case stillmissing of
506		FsckFoundMissing s t
507			| S.null s -> if repoIsLocalBare g
508				then checkbadbranches s
509				else ifM (checkIndex g)
510					( checkbadbranches s
511					, do
512						putStrLn "No missing objects found, but the index file is corrupt!"
513						if forced
514							then corruptedindex
515							else needforce
516					)
517			| otherwise -> if forced
518				then ifM (checkIndex g)
519					( forcerepair s t
520					, corruptedindex
521					)
522				else do
523					putStrLn $ unwords
524						[ show (S.size s)
525						, "missing objects could not be recovered!"
526						]
527					unsuccessfulfinish
528		FsckFailed
529			| forced -> ifM (pure (repoIsLocalBare g) <||> checkIndex g)
530				( do
531					cleanCorruptObjects FsckFailed g
532					stillmissing' <- findBroken False False g
533					case stillmissing' of
534						FsckFailed -> return (False, [])
535						FsckFoundMissing s t -> forcerepair s t
536				, corruptedindex
537				)
538			| otherwise -> unsuccessfulfinish
539  where
540	repairbranches missing = do
541		(removedbranches, goodcommits) <- removeBadBranches' removablebranch missing emptyGoodCommits g
542		let remotebranches = filter isTrackingBranch removedbranches
543		unless (null remotebranches) $
544			putStrLn $ unwords
545				[ "Removed"
546				, show (length remotebranches)
547				, "remote tracking branches that referred to missing objects."
548				]
549		(resetbranches, deletedbranches, _) <- resetLocalBranches missing goodcommits g
550		displayList (map fromRef resetbranches)
551			"Reset these local branches to old versions before the missing objects were committed:"
552		displayList (map fromRef deletedbranches)
553			"Deleted these local branches, which could not be recovered due to missing objects:"
554		return (resetbranches ++ deletedbranches)
555
556	checkbadbranches missing = do
557		bad <- badBranches missing g
558		case (null bad, forced) of
559			(True, _) -> successfulfinish []
560			(False, False) -> do
561				displayList (map fromRef bad)
562					"Some git branches refer to missing objects:"
563				unsuccessfulfinish
564			(False, True) -> successfulfinish =<< repairbranches missing
565
566	forcerepair missing fscktruncated = do
567		modifiedbranches <- repairbranches missing
568		deindexedfiles <- rewriteIndex g
569		displayList deindexedfiles
570			"Removed these missing files from the index. You should look at what files are present in your working tree and git add them back to the index when appropriate."
571
572		-- When the fsck results were truncated, try
573		-- fscking again, and as long as different
574		-- missing objects are found, continue
575		-- the repair process.
576		if fscktruncated
577			then do
578				fsckresult' <- findBroken False False g
579				case fsckresult' of
580					FsckFailed -> do
581						putStrLn "git fsck is failing"
582						return (False, modifiedbranches)
583					FsckFoundMissing s _
584						| S.null s -> successfulfinish modifiedbranches
585						| S.null (s `S.difference` missing) -> do
586							putStrLn $ unwords
587								[ show (S.size s)
588								, "missing objects could not be recovered!"
589								]
590							return (False, modifiedbranches)
591						| otherwise -> do
592							(ok, modifiedbranches') <- runRepairOf fsckresult' removablebranch forced referencerepo g
593							return (ok, modifiedbranches++modifiedbranches')
594			else successfulfinish modifiedbranches
595
596	corruptedindex = do
597		removeWhenExistsWith R.removeLink (indexFile g)
598		-- The corrupted index can prevent fsck from finding other
599		-- problems, so re-run repair.
600		fsckresult' <- findBroken False False g
601		result <- runRepairOf fsckresult' removablebranch forced referencerepo g
602		putStrLn "Removed the corrupted index file. You should look at what files are present in your working tree and git add them back to the index when appropriate."
603		return result
604
605	successfulfinish modifiedbranches
606		| null modifiedbranches = do
607			mapM_ putStrLn
608				[ "Successfully recovered repository!"
609				, "You should run \"git fsck\" to make sure, but it looks like everything was recovered ok."
610				]
611			return (True, modifiedbranches)
612		| otherwise = do
613			unless (repoIsLocalBare g) $ do
614				mcurr <- Branch.currentUnsafe g
615				case mcurr of
616					Nothing -> return ()
617					Just curr -> when (any (== curr) modifiedbranches) $ do
618						putStrLn $ unwords
619							[ "You currently have"
620							, fromRef curr
621							, "checked out. You may have staged changes in the index that can be committed to recover the lost state of this branch!"
622							]
623			putStrLn "Successfully recovered repository!"
624			putStrLn "Please carefully check that the changes mentioned above are ok.."
625			return (True, modifiedbranches)
626
627	unsuccessfulfinish = do
628		if repoIsLocalBare g
629			then do
630				putStrLn "If you have a clone of this bare repository, you should add it as a remote of this repository, and retry."
631				putStrLn "If there are no clones of this repository, you can instead retry with the --force parameter to force recovery to a possibly usable state."
632				return (False, [])
633			else needforce
634	needforce = do
635		putStrLn "To force a recovery to a usable state, retry with the --force parameter."
636		return (False, [])
637
638successfulRepair :: (Bool, [Branch]) -> Bool
639successfulRepair = fst
640
641safeReadFile :: RawFilePath -> IO String
642safeReadFile f = do
643	allowRead f
644	readFileStrict (fromRawFilePath f)
645