fully fix fsck memory use by iterative fscking

Not very well tested, but I'm sure it doesn't eg, loop forever.

1 files changed, 17 insertions, 11 deletions

diff --git a/Logs/FsckResults.hs b/Logs/FsckResults.hs
index 3538bdc40..619dd586c 100644
--- a/Logs/FsckResults.hs
+++ b/Logs/FsckResults.hs
@@ -23,25 +23,31 @@ writeFsckResults u fsckresults = do
 	logfile <- fromRepo $ gitAnnexFsckResultsLog u
 	liftIO $ 
 		case fsckresults of
-			FsckFailed -> store S.empty logfile
-			FsckFoundMissing s
+			FsckFailed -> store S.empty False logfile
+			FsckFoundMissing s t
 				| S.null s -> nukeFile logfile
-				| otherwise -> store s logfile
+				| otherwise -> store s t logfile
   where
-  	store s logfile = do 
+  	store s t logfile = do 
 		createDirectoryIfMissing True (parentDir logfile)
-		liftIO $ viaTmp writeFile logfile $ serialize s
-	serialize = unlines . map fromRef . S.toList
+		liftIO $ viaTmp writeFile logfile $ serialize s t
+	serialize s t =
+		let ls = map fromRef (S.toList s)
+		in if t
+			then unlines ("truncated":ls)
+			else unlines ls
 
 readFsckResults :: UUID -> Annex FsckResults
 readFsckResults u = do
 	logfile <- fromRepo $ gitAnnexFsckResultsLog u
-	liftIO $ catchDefaultIO (FsckFoundMissing S.empty) $
-		deserialize <$> readFile logfile
+	liftIO $ catchDefaultIO (FsckFoundMissing S.empty False) $
+		deserialize . lines <$> readFile logfile
   where
-	deserialize l = 
-		let s = S.fromList $ map Ref $ lines l
-		in if S.null s then FsckFailed else FsckFoundMissing s
+	deserialize ("truncated":ls) = deserialize' ls True
+	deserialize ls = deserialize' ls False
+	deserialize' ls t =
+		let s = S.fromList $ map Ref ls
+		in if S.null s then FsckFailed else FsckFoundMissing s t
 
 clearFsckResults :: UUID -> Annex ()
 clearFsckResults = liftIO . nukeFile <=< fromRepo . gitAnnexFsckResultsLog