assistant: Avoid unncessary git repository repair

In a situation where git fsck gets confused about a commit that is made
while it's running.

Sponsored-by: Graham Spencer on Patreon

Git/Fsck.hs

@@ -1,4 +1,5 @@
 {- git fsck interface
+i it is not fully repoducibleI repeated the same steps
  -
  - Copyright 2013 Joey Hess <id@joeyh.name>
  -
@@ -69,9 +70,17 @@ instance Monoid FsckOutput where
  - 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.
+ -
+ - Note that there is a possible false positive: When changes are being
+ - made to the repo while this is running, fsck might complain about a
+ - missing object that has not made it to disk yet. Catting the object
+ - then succeeds, so it's not included in the FsckResults. But, fsck then
+ - exits nonzero, and so FsckFailed is returned. Set ignorenonzeroexit
+ - to avoid this false positive, at the risk of perhaps missing a problem
+ - so bad that fsck crashes without outputting any missing shas.
  -}
-findBroken :: Bool -> Repo -> IO FsckResults
-findBroken batchmode r = do
+findBroken :: Bool -> Bool -> Repo -> IO FsckResults
+findBroken batchmode ignorenonzeroexit r = do
 	let (command, params) = ("git", fsckParams r)
 	(command', params') <- if batchmode
 		then toBatchCommand (command, params)
@@ -90,10 +99,10 @@ findBroken batchmode r = do
 		fsckok <- checkSuccessProcess pid
 		case mappend o1 o2 of
 			FsckOutput badobjs truncated
-				| S.null badobjs && not fsckok -> return FsckFailed
+				| S.null badobjs && not fsckok -> return fsckfailed
 				| otherwise -> return $ FsckFoundMissing badobjs truncated
 			NoFsckOutput
-				| not fsckok -> return FsckFailed
+				| not fsckok -> return fsckfailed
 				| otherwise -> return noproblem
 			-- If all fsck output was duplicateEntries warnings,
 			-- the repository is not broken, it just has some
@@ -104,6 +113,9 @@ findBroken batchmode r = do
 	
 	maxobjs = 10000
 	noproblem = FsckFoundMissing S.empty False
+	fsckfailed
+		| ignorenonzeroexit = noproblem
+		| otherwise = FsckFailed
 
 foundBroken :: FsckResults -> Bool
 foundBroken FsckFailed = True

Git/Repair.hs

@@ -476,7 +476,7 @@ runRepair :: (Ref -> Bool) -> Bool -> Repo -> IO (Bool, [Branch])
 runRepair removablebranch forced g = do
 	preRepair g
 	putStrLn "Running git fsck ..."
-	fsckresult <- findBroken False g
+	fsckresult <- findBroken False False g
 	if foundBroken fsckresult
 		then do
 			putStrLn "Fsck found problems, attempting repair."
@@ -500,7 +500,7 @@ runRepairOf fsckresult removablebranch forced referencerepo g = do
 runRepair' :: (Ref -> Bool) -> FsckResults -> Bool -> Maybe FilePath -> Repo -> IO (Bool, [Branch])
 runRepair' removablebranch fsckresult forced referencerepo g = do
 	cleanCorruptObjects fsckresult g
-	missing <- findBroken False g
+	missing <- findBroken False False g
 	stillmissing <- retrieveMissingObjects missing referencerepo g
 	case stillmissing of
 		FsckFoundMissing s t
@@ -529,7 +529,7 @@ runRepair' removablebranch fsckresult forced referencerepo g = do
 			| forced -> ifM (pure (repoIsLocalBare g) <||> checkIndex g)
 				( do
 					cleanCorruptObjects FsckFailed g
-					stillmissing' <- findBroken False g
+					stillmissing' <- findBroken False False g
 					case stillmissing' of
 						FsckFailed -> return (False, [])
 						FsckFoundMissing s t -> forcerepair s t
@@ -575,7 +575,7 @@ runRepair' removablebranch fsckresult forced referencerepo g = do
 		-- the repair process.
 		if fscktruncated
 			then do
-				fsckresult' <- findBroken False g
+				fsckresult' <- findBroken False False g
 				case fsckresult' of
 					FsckFailed -> do
 						putStrLn "git fsck is failing"
@@ -597,7 +597,7 @@ runRepair' removablebranch fsckresult forced referencerepo g = do
 		removeWhenExistsWith R.removeLink (indexFile g)
 		-- The corrupted index can prevent fsck from finding other
 		-- problems, so re-run repair.
-		fsckresult' <- findBroken False g
+		fsckresult' <- findBroken False False g
 		result <- runRepairOf fsckresult' removablebranch 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