fsck --from

Fscking a remote is now supported. It's done by retrieving
the contents of the specified files from the remote, and checking them,
so can be an expensive operation.

(Several optimisations are possible, to speed it up, of course.. This is
the slow and stupid remote fsck to start with.)

Still, if the remote is a special remote, or a git repository that you
cannot run fsck in locally, it's nice to have the ability to fsck it.

If you have any directory special remotes, now would be a good time to
fsck them, in case you were hit by the data loss bug fixed in the
previous release!
This commit is contained in:
Joey Hess 2012-01-19 15:24:05 -04:00
parent d36525e974
commit 90319afa41
8 changed files with 131 additions and 44 deletions

View file

@ -20,20 +20,31 @@ import Annex.UUID
import Utility.DataUnits
import Utility.FileMode
import Config
import qualified Option
def :: [Command]
def = [command "fsck" paramPaths seek "check for problems"]
def = [withOptions options $ command "fsck" paramPaths seek
"check for problems"]
fromOption :: Option
fromOption = Option.field ['f'] "from" paramRemote "check remote"
options :: [Option]
options = [fromOption]
seek :: [CommandSeek]
seek =
[ withNumCopies $ \n -> whenAnnexed $ start n
[ withField fromOption Remote.byName $ \from ->
withNumCopies $ \n -> whenAnnexed $ start from n
, withBarePresentKeys startBare
]
start :: Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
start numcopies file (key, backend) = do
start :: Maybe Remote -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
start from numcopies file (key, backend) = do
showStart "fsck" file
next $ perform key file backend numcopies
case from of
Nothing -> next $ perform key file backend numcopies
Just r -> next $ performRemote key file backend numcopies r
perform :: Key -> FilePath -> Backend -> Maybe Int -> CommandPerform
perform key file backend numcopies = check
@ -44,6 +55,27 @@ perform key file backend numcopies = check
, checkKeyNumCopies key file numcopies
]
{- To fsck a remote, the content is retrieved to a tmp file,
- and checked locally. -}
performRemote :: Key -> FilePath -> Backend -> Maybe Int -> Remote -> CommandPerform
performRemote key file backend numcopies remote = withTmp key $ \tmpfile -> do
v <- Remote.hasKey remote key
case v of
Left err -> do
showNote err
stop
Right True -> do
copied <- Remote.retrieveKeyFile remote key tmpfile
if copied then go True (Just tmpfile) else go False Nothing
Right False -> go False Nothing
where
go present localcopy = check
[ verifyLocationLogRemote key file remote present
, checkKeySizeRemote key remote localcopy
, checkBackendRemote backend key remote localcopy
, checkKeyNumCopies key file numcopies
]
{- To fsck a bare repository, fsck each key in the location log. -}
withBarePresentKeys :: (Key -> CommandStart) -> CommandSeek
withBarePresentKeys a params = isBareRepo >>= go
@ -93,26 +125,33 @@ verifyLocationLog key desc = do
preventWrite (parentDir f)
u <- getUUID
uuids <- Remote.keyLocations key
verifyLocationLog' key desc present u (logChange key u)
verifyLocationLogRemote :: Key -> String -> Remote -> Bool -> Annex Bool
verifyLocationLogRemote key desc remote present =
verifyLocationLog' key desc present (Remote.uuid remote)
(Remote.logStatus remote key)
verifyLocationLog' :: Key -> String -> Bool -> UUID -> (LogStatus -> Annex ()) -> Annex Bool
verifyLocationLog' key desc present u bad = do
uuids <- Remote.keyLocations key
case (present, u `elem` uuids) of
(True, False) -> do
fix u InfoPresent
fix InfoPresent
-- There is no data loss, so do not fail.
return True
(False, True) -> do
fix u InfoMissing
fix InfoMissing
warning $
"** Based on the location log, " ++ desc
++ "\n** was expected to be present, " ++
"but its content is missing."
return False
_ -> return True
where
fix u s = do
fix s = do
showNote "fixing location log"
logChange key u s
bad s
{- The size of the data for a key is checked against the size encoded in
- the key's metadata, if available. -}
@ -120,26 +159,49 @@ checkKeySize :: Key -> Annex Bool
checkKeySize key = do
file <- inRepo $ gitAnnexLocation key
present <- liftIO $ doesFileExist file
case (present, Types.Key.keySize key) of
(_, Nothing) -> return True
(False, _) -> return True
(True, Just size) -> do
stat <- liftIO $ getFileStatus file
let size' = fromIntegral (fileSize stat)
if size == size'
then return True
else do
dest <- moveBad key
warning $ "Bad file size (" ++
compareSizes storageUnits True size size' ++
"); moved to " ++ dest
return False
if present
then checkKeySize' key file badContent
else return True
checkKeySizeRemote :: Key -> Remote -> Maybe FilePath -> Annex Bool
checkKeySizeRemote _ _ Nothing = return True
checkKeySizeRemote key remote (Just file) = checkKeySize' key file
(badContentRemote remote)
checkKeySize' :: Key -> FilePath -> (Key -> Annex String) -> Annex Bool
checkKeySize' key file bad = case Types.Key.keySize key of
Nothing -> return True
Just size -> do
stat <- liftIO $ getFileStatus file
let size' = fromIntegral (fileSize stat)
if size == size'
then return True
else do
msg <- bad key
warning $ "Bad file size (" ++
compareSizes storageUnits True size size' ++
"); " ++ msg
return False
checkBackend :: Backend -> Key -> Annex Bool
checkBackend backend key = case Types.Backend.fsckKey backend of
checkBackend backend key = do
file <- inRepo (gitAnnexLocation key)
checkBackend' backend key (Just file) badContent
checkBackendRemote :: Backend -> Key -> Remote -> Maybe FilePath -> Annex Bool
checkBackendRemote backend key remote localcopy =
checkBackend' backend key localcopy (badContentRemote remote)
checkBackend' :: Backend -> Key -> Maybe FilePath -> (Key -> Annex String) -> Annex Bool
checkBackend' _ _ Nothing _ = return True
checkBackend' backend key (Just file) bad = case Types.Backend.fsckKey backend of
Nothing -> return True
Just a -> a key
Just a -> do
ok <- a key file
unless ok $ do
msg <- bad key
warning $ "Bad file content; " ++ msg
return ok
checkKeyNumCopies :: Key -> FilePath -> Maybe Int -> Annex Bool
checkKeyNumCopies key file numcopies = do
@ -168,3 +230,19 @@ missingNote file present needed untrusted =
missingNote file present needed [] ++
"\nThe following untrusted locations may also have copies: " ++
"\n" ++ untrusted
{- Bad content is moved aside. -}
badContent :: Key -> Annex String
badContent key = do
dest <- moveBad key
return $ "moved to " ++ dest
badContentRemote :: Remote -> Key -> Annex String
badContentRemote remote key = do
ok <- Remote.removeKey remote key
-- better safe than sorry: assume the remote dropped the key
-- even if it seemed to fail; the failure could have occurred
-- after it really dropped it
Remote.logStatus remote key InfoMissing
return $ (if ok then "dropped from " else "failed to drop from ")
++ Remote.name remote