queue downloads of keys that fsck finds with bad content
This commit is contained in:
parent
82083658cf
commit
18f4d1b400
4 changed files with 30 additions and 17 deletions
|
@ -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 []
|
||||
)
|
||||
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue