From ac491b4fac4e83f0319e0da7c82f86d81a5b7030 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 20 Nov 2013 20:20:14 -0400 Subject: fix cat-file stall bug Apparently some corruption to an object can cause cat-file to say it's N bytes long, but only output N-M bytes of data. This causes Git.CatFile to stall waiting for the rest. To fix, add a 1 minute timeout to the cat-file, which should be enough time to read any reasonable object. --- Git/Fsck.hs | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) (limited to 'Git/Fsck.hs') diff --git a/Git/Fsck.hs b/Git/Fsck.hs index 350b2bb..2c4d1cd 100644 --- a/Git/Fsck.hs +++ b/Git/Fsck.hs @@ -19,8 +19,10 @@ import Git.Command import Git.Sha import Git.CatFile import Utility.Batch +import Utility.ThreadScheduler import qualified Data.Set as S +import Control.Concurrent.Async type MissingObjects = S.Set Sha @@ -57,8 +59,8 @@ foundBroken (Just s) = not (S.null s) {- Finds objects that are missing from the git repsitory, or are corrupt. - - - Note that catting a corrupt object will cause cat-file to crash; - - this is detected and it's restarted. + - Note that catting a corrupt object will cause cat-file to crash, + - or sometimes to stall; this is detected and it's restarted. -} findMissing :: [Sha] -> Repo -> IO MissingObjects findMissing objs r = go objs [] =<< start @@ -68,7 +70,12 @@ findMissing objs r = go objs [] =<< start void $ tryIO $ catFileStop h return $ S.fromList c go (o:os) c h = do - v <- tryNonAsync $ isNothing <$> catObjectDetails h o + reader <- async $ isNothing <$> catObjectDetails h o + killer <- async $ do + threadDelaySeconds (Seconds 60) + cancel reader + v <- waitCatch reader + cancel killer case v of Left _ -> do void $ tryIO $ catFileStop h -- cgit v1.2.3