summaryrefslogtreecommitdiff
path: root/Command/Fsck.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Command/Fsck.hs')
-rw-r--r--Command/Fsck.hs44
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 ()