diff options
author | 2014-03-12 15:18:43 -0400 | |
---|---|---|
committer | 2014-03-12 15:18:43 -0400 | |
commit | 3a7b7c8ac97f263e5fdf6281ef6812aba4af0042 (patch) | |
tree | 42be53b2ff001d4c8b3471aea090c68de33de879 /Git/Fsck.hs | |
parent | 4d79d2327819111f97954e10dce2c8ce53b0ab31 (diff) |
fully fix fsck memory use by iterative fscking
Not very well tested, but I'm sure it doesn't eg, loop forever.
Diffstat (limited to 'Git/Fsck.hs')
-rw-r--r-- | Git/Fsck.hs | 26 |
1 files changed, 17 insertions, 9 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 |