diff options
Diffstat (limited to 'Command/Fsck.hs')
-rw-r--r-- | Command/Fsck.hs | 44 |
1 files changed, 41 insertions, 3 deletions
diff --git a/Command/Fsck.hs b/Command/Fsck.hs index b6f330d4c..f8c957053 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -7,11 +7,17 @@ module Command.Fsck where +import Control.Monad.State (liftIO) + import Command import qualified Backend +import qualified Annex +import UUID import Types import Messages import Utility +import Content +import LocationLog command :: [Command] command = [Command "fsck" (paramOptional $ paramRepeating paramPath) seek @@ -20,7 +26,6 @@ command = [Command "fsck" (paramOptional $ paramRepeating paramPath) seek seek :: [CommandSeek] seek = [withAttrFilesInGit "annex.numcopies" start] -{- Checks a file's backend data for problems. -} start :: CommandStartAttrFile start (file, attr) = isAnnexed file $ \(key, backend) -> do showStart "fsck" file @@ -30,7 +35,40 @@ start (file, attr) = isAnnexed file $ \(key, backend) -> do perform :: Key -> FilePath -> Backend Annex -> Maybe Int -> CommandPerform perform key file backend numcopies = do - success <- Backend.fsckKey backend key (Just file) numcopies - if success + -- the location log is checked first, so that if it has bad data + -- that gets corrected + locationlogok <- verifyLocationLog key file + backendok <- Backend.fsckKey backend key (Just file) numcopies + if locationlogok && backendok then return $ Just $ return True else return Nothing + +{- Checks that the location log reflects the current status of the key, + in this repository only. -} +verifyLocationLog :: Key -> FilePath -> Annex Bool +verifyLocationLog key file = do + present <- inAnnex key + + g <- Annex.gitRepo + u <- getUUID g + uuids <- liftIO $ keyLocations g key + + case (present, u `elem` uuids) of + (True, False) -> do + fix g u ValuePresent + -- There is no data loss, so do not fail. + return True + (False, True) -> do + fix g u ValueMissing + warning $ + "** Based on the location log, " ++ file + ++ "\n** was expected to be present, " ++ + "but its content is missing." + return False + _ -> return True + + where + fix g u s = do + showNote "fixing location log" + _ <- liftIO $ logChange g key u s + return () |