diff options
Diffstat (limited to 'Git')
| -rw-r--r-- | Git/Fsck.hs | 26 | ||||
| -rw-r--r-- | Git/Repair.hs | 101 |
2 files changed, 81 insertions, 46 deletions
diff --git a/Git/Fsck.hs b/Git/Fsck.hs index e8fa02129..80f76dd90 100644 --- a/Git/Fsck.hs +++ b/Git/Fsck.hs @@ -28,7 +28,12 @@ import Control.Concurrent.Async type MissingObjects = S.Set Sha -data FsckResults = FsckFoundMissing MissingObjects | FsckFailed +data FsckResults + = FsckFoundMissing + { missingObjects :: MissingObjects + , missingObjectsTruncated :: Bool + } + | FsckFailed deriving (Show) {- Runs fsck to find some of the broken objects in the repository. @@ -55,22 +60,25 @@ findBroken batchmode r = do , std_err = CreatePipe } (bad1, bad2) <- concurrently - (readMissingObjs r supportsNoDangling (stdoutHandle p)) - (readMissingObjs r supportsNoDangling (stderrHandle p)) + (readMissingObjs maxobjs r supportsNoDangling (stdoutHandle p)) + (readMissingObjs maxobjs r supportsNoDangling (stderrHandle p)) fsckok <- checkSuccessProcess pid + let truncated = S.size bad1 == maxobjs || S.size bad1 == maxobjs let badobjs = S.union bad1 bad2 if S.null badobjs && not fsckok then return FsckFailed - else return $ FsckFoundMissing badobjs + else return $ FsckFoundMissing badobjs truncated + where + maxobjs = 10000 foundBroken :: FsckResults -> Bool foundBroken FsckFailed = True -foundBroken (FsckFoundMissing s) = not (S.null s) +foundBroken (FsckFoundMissing s _) = not (S.null s) knownMissing :: FsckResults -> MissingObjects knownMissing FsckFailed = S.empty -knownMissing (FsckFoundMissing s) = s +knownMissing (FsckFoundMissing s _) = s {- Finds objects that are missing from the git repsitory, or are corrupt. - @@ -80,9 +88,9 @@ knownMissing (FsckFoundMissing s) = s findMissing :: [Sha] -> Repo -> IO MissingObjects findMissing objs r = S.fromList <$> filterM (`isMissing` r) objs -readMissingObjs :: Repo -> Bool -> Handle -> IO MissingObjects -readMissingObjs r supportsNoDangling h = do - objs <- findShas supportsNoDangling <$> hGetContents h +readMissingObjs :: Int -> Repo -> Bool -> Handle -> IO MissingObjects +readMissingObjs maxobjs r supportsNoDangling h = do + objs <- take maxobjs . findShas supportsNoDangling <$> hGetContents h findMissing objs r isMissing :: Sha -> Repo -> IO Bool diff --git a/Git/Repair.hs b/Git/Repair.hs index 0f31854b7..67ded359f 100644 --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -1,7 +1,6 @@ {- git repository recovery -import qualified Data.Set as S - - - Copyright 2013 Joey Hess <joey@kitenet.net> + - Copyright 2013-2014 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} @@ -115,7 +114,9 @@ retrieveMissingObjects missing referencerepo r void $ copyObjects tmpr r case stillmissing of FsckFailed -> return $ FsckFailed - FsckFoundMissing s -> FsckFoundMissing <$> findMissing (S.toList s) r + FsckFoundMissing s t -> FsckFoundMissing + <$> findMissing (S.toList s) r + <*> pure t , return stillmissing ) pullremotes tmpr (rmt:rmts) fetchrefs ms @@ -128,9 +129,9 @@ retrieveMissingObjects missing referencerepo r void $ copyObjects tmpr r case ms of FsckFailed -> pullremotes tmpr rmts fetchrefs ms - FsckFoundMissing s -> do + FsckFoundMissing s t -> do stillmissing <- findMissing (S.toList s) r - pullremotes tmpr rmts fetchrefs (FsckFoundMissing stillmissing) + pullremotes tmpr rmts fetchrefs (FsckFoundMissing stillmissing t) , pullremotes tmpr rmts fetchrefs ms ) fetchfrom fetchurl ps = runBool $ @@ -278,7 +279,7 @@ findUncorruptedCommit missing goodcommits branch r = do then return (Just c, gcs') else findfirst gcs' cs -{- Verifies tha none of the missing objects in the set are used by +{- Verifies that none of the missing objects in the set are used by - the commit. Also adds to a set of commit shas that have been verified to - be good, which can be passed into subsequent calls to avoid - redundant work when eg, chasing down branches to find the first @@ -452,7 +453,7 @@ runRepair' removablebranch fsckresult forced referencerepo g = do missing <- findBroken False g stillmissing <- retrieveMissingObjects missing referencerepo g case stillmissing of - FsckFoundMissing s + FsckFoundMissing s t | S.null s -> if repoIsLocalBare g then successfulfinish [] else ifM (checkIndex g) @@ -465,7 +466,7 @@ runRepair' removablebranch fsckresult forced referencerepo g = do ) | otherwise -> if forced then ifM (checkIndex g) - ( continuerepairs s + ( forcerepair s t , corruptedindex ) else do @@ -478,17 +479,16 @@ runRepair' removablebranch fsckresult forced referencerepo g = do | forced -> ifM (pure (repoIsLocalBare g) <||> checkIndex g) ( do cleanCorruptObjects FsckFailed g - missing' <- findBroken False g - case missing' of + stillmissing' <- findBroken False g + case stillmissing' of FsckFailed -> return (False, []) - FsckFoundMissing stillmissing' -> - continuerepairs stillmissing' + FsckFoundMissing s t -> forcerepair s t , corruptedindex ) | otherwise -> unsuccessfulfinish where - continuerepairs stillmissing = do - (removedbranches, goodcommits) <- removeBadBranches removablebranch stillmissing emptyGoodCommits g + repairbranches missing = do + (removedbranches, goodcommits) <- removeBadBranches removablebranch missing emptyGoodCommits g let remotebranches = filter isTrackingBranch removedbranches unless (null remotebranches) $ putStrLn $ unwords @@ -496,32 +496,43 @@ runRepair' removablebranch fsckresult forced referencerepo g = do , show (length remotebranches) , "remote tracking branches that referred to missing objects." ] - (resetbranches, deletedbranches, _) <- resetLocalBranches stillmissing goodcommits g + (resetbranches, deletedbranches, _) <- resetLocalBranches missing goodcommits g displayList (map fromRef resetbranches) "Reset these local branches to old versions before the missing objects were committed:" displayList (map fromRef deletedbranches) "Deleted these local branches, which could not be recovered due to missing objects:" + return (resetbranches ++ deletedbranches) + + forcerepair missing fscktruncated = do + modifiedbranches <- repairbranches missing deindexedfiles <- rewriteIndex g displayList deindexedfiles "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." - let modifiedbranches = resetbranches ++ deletedbranches - if null resetbranches && null deletedbranches - then successfulfinish modifiedbranches - else do - unless (repoIsLocalBare g) $ do - mcurr <- Branch.currentUnsafe g - case mcurr of - Nothing -> return () - Just curr -> when (any (== curr) modifiedbranches) $ do + + -- When the fsck results were truncated, try + -- fscking again, and as long as different + -- missing objects are found, continue + -- the repair process. + if fscktruncated + then do + fsckresult' <- findBroken False g + case fsckresult' of + FsckFailed -> do + putStrLn "git fsck is failing" + return (False, modifiedbranches) + FsckFoundMissing s _ + | S.null s -> successfulfinish modifiedbranches + | S.null (s `S.difference` missing) -> do putStrLn $ unwords - [ "You currently have" - , fromRef curr - , "checked out. You may have staged changes in the index that can be committed to recover the lost state of this branch!" + [ show (S.size s) + , "missing objects could not be recovered!" ] - putStrLn "Successfully recovered repository!" - putStrLn "Please carefully check that the changes mentioned above are ok.." - return (True, modifiedbranches) - + return (False, modifiedbranches) + | otherwise -> do + (ok, modifiedbranches') <- runRepairOf fsckresult' removablebranch forced referencerepo g + return (ok, modifiedbranches++modifiedbranches') + else successfulfinish modifiedbranches + corruptedindex = do nukeFile (indexFile g) -- The corrupted index can prevent fsck from finding other @@ -531,12 +542,28 @@ runRepair' removablebranch fsckresult forced referencerepo g = do 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." return result - successfulfinish modifiedbranches = do - mapM_ putStrLn - [ "Successfully recovered repository!" - , "You should run \"git fsck\" to make sure, but it looks like everything was recovered ok." - ] - return (True, modifiedbranches) + successfulfinish modifiedbranches + | null modifiedbranches = do + mapM_ putStrLn + [ "Successfully recovered repository!" + , "You should run \"git fsck\" to make sure, but it looks like everything was recovered ok." + ] + return (True, modifiedbranches) + | otherwise = do + unless (repoIsLocalBare g) $ do + mcurr <- Branch.currentUnsafe g + case mcurr of + Nothing -> return () + Just curr -> when (any (== curr) modifiedbranches) $ do + putStrLn $ unwords + [ "You currently have" + , fromRef curr + , "checked out. You may have staged changes in the index that can be committed to recover the lost state of this branch!" + ] + putStrLn "Successfully recovered repository!" + putStrLn "Please carefully check that the changes mentioned above are ok.." + return (True, modifiedbranches) + unsuccessfulfinish = do if repoIsLocalBare g then do |