From ea8b6cdf35d2993a06d2ad546c8347bbab4410a0 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 20 Nov 2013 16:07:53 -0400
Subject: remove fsck tryharder code

It turned out to be broken, and led to failures.
6d67245728bbbc07ad1eeaf5b3c49f64c6bbcd11 was a better fix for the problem
that code tried to fix.
---
 Git/Fsck.hs | 45 ++++++++-------------------------------------
 1 file changed, 8 insertions(+), 37 deletions(-)

(limited to 'Git/Fsck.hs')

diff --git a/Git/Fsck.hs b/Git/Fsck.hs
index ad92cdb..9c62ae0 100644
--- a/Git/Fsck.hs
+++ b/Git/Fsck.hs
@@ -21,8 +21,6 @@ import Git.CatFile
 import Utility.Batch
 
 import qualified Data.Set as S
-import System.Process (std_err, std_out)
-import Control.Concurrent
 
 type MissingObjects = S.Set Sha
 
@@ -38,47 +36,20 @@ type FsckResults = Maybe MissingObjects
  - look for anything in its output (both stdout and stderr) that appears
  - to be a git sha. Not all such shas are of broken objects, so ask git
  - to try to cat the object, and see if it fails.
- -
- - Some forms of corruption will crash fsck in ways that does not let it
- - output the sha of the broken object. In such a case, Nothing will be
- - returned. In this case, to find broken objects, re-run with tryharder
- - set to True. This makes fsck run in verbose mode, so it prints out
- - shas before checking them. We assume that the last sha is the one that
- - it crashed on, and it may have crashed following from eg, a commit to a
- - tree to a subtree. So, run git show on the sha, and examin the stderr
- - to find an actual bad sha.
  -}
-findBroken :: Bool -> Bool -> Repo -> IO FsckResults
-findBroken batchmode tryharder r = do
+findBroken :: Bool -> Repo -> IO FsckResults
+findBroken batchmode r = do
 	(output, fsckok) <- processTranscript command' (toCommand params') Nothing
 	let objs = findShas output
-	if fsckok || not tryharder
+	if fsckok
 		then do
 			badobjs <- findMissing objs r
 			if S.null badobjs && not fsckok
 				then return Nothing
 				else return $ Just badobjs
-		else case lastMaybe objs of
-			Nothing -> return Nothing
-			Just o -> do
-				p@(_, _, _, pid) <- createProcess $
-					( proc "git" $ toCommand $ gitCommandLine [ Param "show", Param $ show o ] r )
-					{ std_err = CreatePipe
-					, std_out = CreatePipe
-					}
-				void $ forkIO $ void $ hGetContents (stdoutHandle p)
-				objs' <- findShas <$>
-					hGetContentsStrict (stderrHandle p)
-				badobjs <- findMissing objs' r
-				ifM (checkSuccessProcess pid)
-					( if S.null badobjs
-						then return Nothing
-						else return $ Just badobjs
-					, return $ Just $ S.singleton o
-					)
-
+		else return Nothing
   where
-	(command, params) = ("git", fsckParams tryharder r)
+	(command, params) = ("git", fsckParams r)
 	(command', params')
 		| batchmode = toBatchCommand (command, params)
 		| otherwise = (command, params)
@@ -111,9 +82,9 @@ findMissing objs r = go objs [] =<< start
 findShas :: String -> [Sha]
 findShas = catMaybes . map extractSha . concat . map words . lines
 
-fsckParams :: Bool -> Repo -> [CommandParam]
-fsckParams verbose = gitCommandLine $
+fsckParams :: Repo -> [CommandParam]
+fsckParams = gitCommandLine $
 	[ Param "fsck"
 	, Param "--no-dangling"
 	, Param "--no-reflogs"
-	] ++ if verbose then [ Param "--verbose" ] else []
+	]
-- 
cgit v1.2.3