queue downloads of keys that fsck finds with bad content

4 files changed, 30 insertions, 17 deletions

diff --git a/Annex/Content.hs b/Annex/Content.hs
index da0189c74..66ca7be18 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -30,6 +30,7 @@ module Annex.Content (
 	freezeContent,
 	thawContent,
 	cleanObjectLoc,
+	dirKeys,
 ) where
 
 import System.IO.Unsafe (unsafeInterleaveIO)
@@ -522,3 +523,18 @@ thawContent file = unlessM crippledFileSystem $
 	go GroupShared = groupWriteRead file
 	go AllShared = groupWriteRead file
 	go _ = allowWrite file
+
+{- Finds files directly inside a directory like gitAnnexBadDir 
+ - (not in subdirectories) and returns the corresponding keys. -}
+dirKeys :: (Git.Repo -> FilePath) -> Annex [Key]
+dirKeys dirspec = do
+	dir <- fromRepo dirspec
+	ifM (liftIO $ doesDirectoryExist dir)
+		( do
+			contents <- liftIO $ getDirectoryContents dir
+			files <- liftIO $ filterM doesFileExist $
+				map (dir </>) contents
+			return $ mapMaybe (fileKey . takeFileName) files
+		, return []
+		)
+
diff --git a/Assistant/Threads/Cronner.hs b/Assistant/Threads/Cronner.hs
index 78b6a480c..1a27e3c1b 100644
--- a/Assistant/Threads/Cronner.hs
+++ b/Assistant/Threads/Cronner.hs
@@ -22,6 +22,9 @@ import Types.ScheduledActivity
 import Utility.ThreadScheduler
 import Utility.HumanTime
 import qualified Build.SysConfig
+import Assistant.TransferQueue
+import Annex.Content
+import Logs.Transfer
 
 import Control.Concurrent.Async
 import Data.Time.LocalTime
@@ -123,13 +126,19 @@ secondsUntilLocalTime t = do
 		else Seconds 0
 
 runActivity :: ScheduledActivity -> Assistant ()
-runActivity (ScheduledSelfFsck _ d) = liftIO $ do
-	program <- readProgramFile
-	void $ niceShell $
+runActivity (ScheduledSelfFsck _ d) = do
+	program <- liftIO $ readProgramFile
+	void $ liftIO $ niceShell $
 		program ++ " fsck --incremental-schedule=1d --time-limit=" ++ fromDuration d
+	queueBad
 runActivity (ScheduledRemoteFsck _ _ _) =
 	debug ["remote fsck not implemented yet"]
 
+queueBad :: Assistant ()
+queueBad = mapM_ queue =<< liftAnnex (dirKeys gitAnnexBadDir)
+  where
+	queue k = queueTransfers "fsck found bad file; redownloading" Next k Nothing Download
+
 {- Runs a shell command niced, until it terminates.
  - 
  - When an async exception is received, the command is sent a SIGTERM,
diff --git a/Command/Status.hs b/Command/Status.hs
index e9df79eb3..21d46c5ec 100644
--- a/Command/Status.hs
+++ b/Command/Status.hs
@@ -363,7 +363,7 @@ showSizeKeys d = total ++ missingnote
 			" keys of unknown size"
 
 staleSize :: String -> (Git.Repo -> FilePath) -> Stat
-staleSize label dirspec = go =<< lift (Command.Unused.staleKeys dirspec)
+staleSize label dirspec = go =<< lift (dirKeys dirspec)
   where
 	go [] = nostat
 	go keys = onsize =<< sum <$> keysizes keys
diff --git a/Command/Unused.hs b/Command/Unused.hs
index d49cda54b..6210b2115 100644
--- a/Command/Unused.hs
+++ b/Command/Unused.hs
@@ -304,7 +304,7 @@ withKeysReferencedInGitRef a ref = do
  -}
 staleKeysPrune :: (Git.Repo -> FilePath) -> Bool -> Annex [Key]
 staleKeysPrune dirspec nottransferred = do
-	contents <- staleKeys dirspec
+	contents <- dirKeys dirspec
 	
 	dups <- filterM inAnnex contents
 	let stale = contents `exclude` dups
@@ -319,18 +319,6 @@ staleKeysPrune dirspec nottransferred = do
 			return $ filter (`S.notMember` inprogress) stale
 		else return stale
 
-staleKeys :: (Git.Repo -> FilePath) -> Annex [Key]
-staleKeys dirspec = do
-	dir <- fromRepo dirspec
-	ifM (liftIO $ doesDirectoryExist dir)
-		( do
-			contents <- liftIO $ getDirectoryContents dir
-			files <- liftIO $ filterM doesFileExist $
-				map (dir </>) contents
-			return $ mapMaybe (fileKey . takeFileName) files
-		, return []
-		)
-
 data UnusedMaps = UnusedMaps
 	{ unusedMap :: UnusedMap
 	, unusedBadMap :: UnusedMap