queue downloads of keys that fsck finds with bad content

This commit is contained in:
Joey Hess 2013-10-10 17:27:00 -04:00
parent 82083658cf
commit 18f4d1b400
4 changed files with 30 additions and 17 deletions

View file

@ -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 []
)

View file

@ -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,

View file

@ -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

View file

@ -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