fsck: Check for and repair location log damage.

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 ()