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