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 ++++++++-------------------------------------
 Git/Repair.hs |  8 ++++----
 2 files changed, 12 insertions(+), 41 deletions(-)

(limited to 'Git')

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 []
+	]
diff --git a/Git/Repair.hs b/Git/Repair.hs
index 7945bcb..4ae0008 100644
--- a/Git/Repair.hs
+++ b/Git/Repair.hs
@@ -76,7 +76,7 @@ cleanCorruptObjects mmissing r = check mmissing
 				else return $ Just bad
 	retry oldbad = do
 		putStrLn "Re-running git fsck to see if it finds more problems."
-		v <- findBroken False True r
+		v <- findBroken False r
 		case v of
 			Nothing -> do
 				hPutStrLn stderr $ unwords
@@ -474,7 +474,7 @@ runRepair :: Bool -> Repo -> IO (Bool, MissingObjects, [Branch])
 runRepair forced g = do
 	preRepair g
 	putStrLn "Running git fsck ..."
-	fsckresult <- findBroken False False g
+	fsckresult <- findBroken False g
 	if foundBroken fsckresult
 		then runRepairOf fsckresult forced Nothing g
 		else do
@@ -508,7 +508,7 @@ runRepairOf fsckresult forced referencerepo g = do
 		Nothing
 			| forced -> ifM (pure (repoIsLocalBare g) <||> checkIndex S.empty g)
 				( do
-					fsckresult' <- findBroken False False g
+					fsckresult' <- findBroken False g
 					case fsckresult' of
 						Nothing -> do
 							putStrLn "Unable to fully recover; cannot find missing objects."
@@ -556,7 +556,7 @@ runRepairOf fsckresult forced referencerepo g = do
 		nukeIndex g
 		-- The corrupted index can prevent fsck from finding other
 		-- problems, so re-run repair.
-		fsckresult' <- findBroken False False g
+		fsckresult' <- findBroken False g
 		result <- runRepairOf fsckresult' forced referencerepo g
 		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
-- 
cgit v1.2.3