fsck: Added --distributed and --expire options, for distributed fsck.
This commit is contained in:
Joey Hess
parent
724a94a6d4
commit
656fc1c881
7 changed files with 206 additions and 64 deletions
186
Command/Fsck.hs
186
Command/Fsck.hs
|
|
@ -22,6 +22,7 @@ import Annex.Direct
|
|||
import Annex.Perms
|
||||
import Annex.Link
|
||||
import Logs.Location
|
||||
import Logs.Presence
|
||||
import Logs.Trust
|
||||
import Config.NumCopies
|
||||
import Annex.UUID
|
||||
|
|
@ -38,6 +39,7 @@ import Data.Time.Clock.POSIX
|
|||
import Data.Time
|
||||
import System.Posix.Types (EpochTime)
|
||||
import System.Locale
|
||||
import qualified Data.Map as M
|
||||
|
||||
cmd :: [Command]
|
||||
cmd = [withOptions fsckOptions $ command "fsck" paramPaths seek
|
||||
|
|
@ -56,12 +58,22 @@ incrementalScheduleOption :: Option
|
|||
incrementalScheduleOption = fieldOption [] "incremental-schedule" paramTime
|
||||
"schedule incremental fscking"
|
||||
|
||||
distributedOption :: Option
|
||||
distributedOption = flagOption [] "distributed" "distributed fsck mode"
|
||||
|
||||
expireOption :: Option
|
||||
expireOption = fieldOption [] "expire"
|
||||
(paramRepeating $ paramOptional paramRemote ++ ":" ++ paramTime)
|
||||
"distributed expire mode"
|
||||
|
||||
fsckOptions :: [Option]
|
||||
fsckOptions =
|
||||
[ fsckFromOption
|
||||
, startIncrementalOption
|
||||
, moreIncrementalOption
|
||||
, incrementalScheduleOption
|
||||
, distributedOption
|
||||
, expireOption
|
||||
] ++ keyOptions ++ annexedMatchingOptions
|
||||
|
||||
seek :: CommandSeek
|
||||
|
|
@ -69,62 +81,28 @@ seek ps = do
|
|||
from <- getOptionField fsckFromOption Remote.byNameWithUUID
|
||||
u <- maybe getUUID (pure . Remote.uuid) from
|
||||
i <- getIncremental u
|
||||
d <- getDistributed
|
||||
withKeyOptions False
|
||||
(\k -> startKey i k =<< getNumCopies)
|
||||
(withFilesInGit $ whenAnnexed $ start from i)
|
||||
(\k -> startKey i d k =<< getNumCopies)
|
||||
(withFilesInGit $ whenAnnexed $ start from i d)
|
||||
ps
|
||||
withFsckDb i FsckDb.closeDb
|
||||
|
||||
getIncremental :: UUID -> Annex Incremental
|
||||
getIncremental u = do
|
||||
i <- maybe (return False) (checkschedule . parseDuration)
|
||||
=<< Annex.getField (optionName incrementalScheduleOption)
|
||||
starti <- Annex.getFlag (optionName startIncrementalOption)
|
||||
morei <- Annex.getFlag (optionName moreIncrementalOption)
|
||||
case (i, starti, morei) of
|
||||
(False, False, False) -> return NonIncremental
|
||||
(False, True, False) -> startIncremental
|
||||
(False ,False, True) -> contIncremental
|
||||
(True, False, False) ->
|
||||
maybe startIncremental (const contIncremental)
|
||||
=<< getStartTime u
|
||||
_ -> error "Specify only one of --incremental, --more, or --incremental-schedule"
|
||||
where
|
||||
startIncremental = do
|
||||
recordStartTime u
|
||||
ifM (FsckDb.newPass u)
|
||||
( StartIncremental <$> FsckDb.openDb u
|
||||
, error "Cannot start a new --incremental fsck pass; another fsck process is already running."
|
||||
)
|
||||
contIncremental = ContIncremental <$> FsckDb.openDb u
|
||||
|
||||
checkschedule Nothing = error "bad --incremental-schedule value"
|
||||
checkschedule (Just delta) = do
|
||||
Annex.addCleanup FsckCleanup $ do
|
||||
v <- getStartTime u
|
||||
case v of
|
||||
Nothing -> noop
|
||||
Just started -> do
|
||||
now <- liftIO getPOSIXTime
|
||||
when (now - realToFrac started >= durationToPOSIXTime delta) $
|
||||
resetStartTime u
|
||||
return True
|
||||
|
||||
start :: Maybe Remote -> Incremental -> FilePath -> Key -> CommandStart
|
||||
start from inc file key = do
|
||||
start :: Maybe Remote -> Incremental -> Distributed -> FilePath -> Key -> CommandStart
|
||||
start from inc dist file key = do
|
||||
v <- Backend.getBackend file key
|
||||
case v of
|
||||
Nothing -> stop
|
||||
Just backend -> do
|
||||
numcopies <- getFileNumCopies file
|
||||
case from of
|
||||
Nothing -> go $ perform key file backend numcopies
|
||||
Just r -> go $ performRemote key file backend numcopies r
|
||||
Nothing -> go $ perform dist key file backend numcopies
|
||||
Just r -> go $ performRemote dist key file backend numcopies r
|
||||
where
|
||||
go = runFsck inc file key
|
||||
|
||||
perform :: Key -> FilePath -> Backend -> NumCopies -> Annex Bool
|
||||
perform key file backend numcopies = check
|
||||
perform :: Distributed -> Key -> FilePath -> Backend -> NumCopies -> Annex Bool
|
||||
perform dist key file backend numcopies = check
|
||||
-- order matters
|
||||
[ fixLink key file
|
||||
, verifyLocationLog key file
|
||||
|
|
@ -132,13 +110,14 @@ perform key file backend numcopies = check
|
|||
, verifyDirectMode key file
|
||||
, checkKeySize key
|
||||
, checkBackend backend key (Just file)
|
||||
, checkDistributed dist key Nothing
|
||||
, checkKeyNumCopies key file numcopies
|
||||
]
|
||||
|
||||
{- To fsck a remote, the content is retrieved to a tmp file,
|
||||
- and checked locally. -}
|
||||
performRemote :: Key -> FilePath -> Backend -> NumCopies -> Remote -> Annex Bool
|
||||
performRemote key file backend numcopies remote =
|
||||
performRemote :: Distributed -> Key -> FilePath -> Backend -> NumCopies -> Remote -> Annex Bool
|
||||
performRemote dist key file backend numcopies remote =
|
||||
dispatch =<< Remote.hasKey remote key
|
||||
where
|
||||
dispatch (Left err) = do
|
||||
|
|
@ -157,6 +136,7 @@ performRemote key file backend numcopies remote =
|
|||
[ verifyLocationLogRemote key file remote present
|
||||
, checkKeySizeRemote key remote localcopy
|
||||
, checkBackendRemote backend key remote localcopy
|
||||
, checkDistributed dist key (Just $ Remote.uuid remote)
|
||||
, checkKeyNumCopies key file numcopies
|
||||
]
|
||||
withtmp a = do
|
||||
|
|
@ -177,18 +157,19 @@ performRemote key file backend numcopies remote =
|
|||
)
|
||||
dummymeter _ = noop
|
||||
|
||||
startKey :: Incremental -> Key -> NumCopies -> CommandStart
|
||||
startKey inc key numcopies =
|
||||
startKey :: Incremental -> Distributed -> Key -> NumCopies -> CommandStart
|
||||
startKey inc dist key numcopies =
|
||||
case Backend.maybeLookupBackendName (Types.Key.keyBackendName key) of
|
||||
Nothing -> stop
|
||||
Just backend -> runFsck inc (key2file key) key $
|
||||
performKey key backend numcopies
|
||||
performKey dist key backend numcopies
|
||||
|
||||
performKey :: Key -> Backend -> NumCopies -> Annex Bool
|
||||
performKey key backend numcopies = check
|
||||
performKey :: Distributed -> Key -> Backend -> NumCopies -> Annex Bool
|
||||
performKey dist key backend numcopies = check
|
||||
[ verifyLocationLog key (key2file key)
|
||||
, checkKeySize key
|
||||
, checkBackend backend key Nothing
|
||||
, checkDistributed dist key Nothing
|
||||
, checkKeyNumCopies key (key2file key) numcopies
|
||||
]
|
||||
|
||||
|
|
@ -421,8 +402,6 @@ badContentRemote remote key = do
|
|||
return $ (if ok then "dropped from " else "failed to drop from ")
|
||||
++ Remote.name remote
|
||||
|
||||
data Incremental = StartIncremental FsckDb.FsckHandle | ContIncremental FsckDb.FsckHandle | NonIncremental
|
||||
|
||||
runFsck :: Incremental -> FilePath -> Key -> Annex Bool -> CommandStart
|
||||
runFsck inc file key a = ifM (needFsck inc key)
|
||||
( do
|
||||
|
|
@ -497,3 +476,106 @@ getStartTime u = do
|
|||
#else
|
||||
fromfile >= fromstatus
|
||||
#endif
|
||||
|
||||
data Incremental = StartIncremental FsckDb.FsckHandle | ContIncremental FsckDb.FsckHandle | NonIncremental
|
||||
|
||||
getIncremental :: UUID -> Annex Incremental
|
||||
getIncremental u = do
|
||||
i <- maybe (return False) (checkschedule . parseDuration)
|
||||
=<< Annex.getField (optionName incrementalScheduleOption)
|
||||
starti <- getOptionFlag startIncrementalOption
|
||||
morei <- getOptionFlag moreIncrementalOption
|
||||
case (i, starti, morei) of
|
||||
(False, False, False) -> return NonIncremental
|
||||
(False, True, False) -> startIncremental
|
||||
(False ,False, True) -> contIncremental
|
||||
(True, False, False) ->
|
||||
maybe startIncremental (const contIncremental)
|
||||
=<< getStartTime u
|
||||
_ -> error "Specify only one of --incremental, --more, or --incremental-schedule"
|
||||
where
|
||||
startIncremental = do
|
||||
recordStartTime u
|
||||
ifM (FsckDb.newPass u)
|
||||
( StartIncremental <$> FsckDb.openDb u
|
||||
, error "Cannot start a new --incremental fsck pass; another fsck process is already running."
|
||||
)
|
||||
contIncremental = ContIncremental <$> FsckDb.openDb u
|
||||
|
||||
checkschedule Nothing = error "bad --incremental-schedule value"
|
||||
checkschedule (Just delta) = do
|
||||
Annex.addCleanup FsckCleanup $ do
|
||||
v <- getStartTime u
|
||||
case v of
|
||||
Nothing -> noop
|
||||
Just started -> do
|
||||
now <- liftIO getPOSIXTime
|
||||
when (now - realToFrac started >= durationToPOSIXTime delta) $
|
||||
resetStartTime u
|
||||
return True
|
||||
|
||||
data Distributed
|
||||
= NonDistributed
|
||||
| Distributed POSIXTime
|
||||
| DistributedExpire POSIXTime (M.Map (Maybe UUID) (Maybe POSIXTime))
|
||||
deriving (Show)
|
||||
|
||||
getDistributed :: Annex Distributed
|
||||
getDistributed = go =<< getOptionField expireOption parseexpire
|
||||
where
|
||||
go (Just m) = DistributedExpire <$> liftIO getPOSIXTime <*> pure m
|
||||
go Nothing = ifM (getOptionFlag distributedOption)
|
||||
( Distributed <$> liftIO getPOSIXTime
|
||||
, return NonDistributed
|
||||
)
|
||||
|
||||
parseexpire Nothing = return Nothing
|
||||
parseexpire (Just s) = do
|
||||
now <- liftIO getPOSIXTime
|
||||
Just . M.fromList <$> mapM (parseexpire' now) (words s)
|
||||
parseexpire' now s = case separate (== ':') s of
|
||||
(t, []) -> return (Nothing, parsetime now t)
|
||||
(n, t) -> do
|
||||
r <- Remote.nameToUUID n
|
||||
return (Just r, parsetime now t)
|
||||
parsetime _ "never" = Nothing
|
||||
parsetime now s = case parseDuration s of
|
||||
Nothing -> error $ "bad expire time: " ++ s
|
||||
Just d -> Just (now - durationToPOSIXTime d)
|
||||
|
||||
checkDistributed :: Distributed -> Key -> Maybe UUID -> Annex Bool
|
||||
checkDistributed d k mu = do
|
||||
go d
|
||||
return True
|
||||
where
|
||||
go NonDistributed = noop
|
||||
|
||||
-- This is called after fsck has checked the key's content, so
|
||||
-- if the key is present in the annex now, we just need to update
|
||||
-- the location log with the timestamp of the start of the fsck.
|
||||
--
|
||||
-- Note that reusing this timestamp means that the same log line
|
||||
-- is generated for each key, which keeps the size increase
|
||||
-- of the git-annex branch down.
|
||||
go (Distributed ts) = whenM (inAnnex k) $ do
|
||||
u <- maybe getUUID return mu
|
||||
logChange' (logThen ts) k u InfoPresent
|
||||
|
||||
-- Get the location log for the key, and expire all entries
|
||||
-- that are older than their uuid's listed expiration date.
|
||||
-- (Except for the local repository.)
|
||||
go (DistributedExpire ts m) = do
|
||||
ls <- locationLog k
|
||||
hereu <- getUUID
|
||||
forM_ ls $ \l -> do
|
||||
let u = toUUID (info l)
|
||||
unless (u == hereu) $
|
||||
case lookupexpire u of
|
||||
Just (Just expiretime)
|
||||
| date l < expiretime ->
|
||||
logChange' (logThen ts) k u InfoMissing
|
||||
_ -> noop
|
||||
where
|
||||
lookupexpire u = headMaybe $ catMaybes $
|
||||
map (`M.lookup` m) [Just u, Nothing]
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue