1 files changed, 75 insertions, 2 deletions
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 988cfd28d..446d25a44 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -9,10 +9,15 @@ module Command.Fsck where
 
 import Control.Monad (when)
 import Control.Monad.State (liftIO)
+import System.Directory
+import Data.List
+import System.Posix.Files
 
 import Command
-import qualified Backend
 import qualified Annex
+import qualified Remote
+import qualified Types.Backend
+import qualified Types.Key
 import UUID
 import Types
 import Messages
@@ -20,6 +25,9 @@ import Utility
 import Content
 import LocationLog
 import Locations
+import Trust
+import DataUnits
+import Config
 
 command :: [Command]
 command = [repoCommand "fsck" (paramOptional $ paramRepeating paramPath) seek
@@ -40,7 +48,7 @@ perform key file backend numcopies = do
 	-- 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
+	backendok <- fsckKey backend key (Just file) numcopies
 	if locationlogok && backendok
 		then next $ return True
 		else stop
@@ -80,3 +88,68 @@ verifyLocationLog key file = do
 		fix g u s = do
 			showNote "fixing location log"
 			logChange g key u s
+
+{- Checks a key for problems. -}
+fsckKey :: Backend Annex -> Key -> Maybe FilePath -> Maybe Int -> Annex Bool
+fsckKey backend key file numcopies = do
+	size_ok <- checkKeySize key
+	copies_ok <- checkKeyNumCopies key file numcopies
+	backend_ok <-(Types.Backend.fsckKey backend) key
+	return $ size_ok && copies_ok && backend_ok
+
+{- The size of the data for a key is checked against the size encoded in
+ - the key's metadata, if available. -}
+checkKeySize :: Key -> Annex Bool
+checkKeySize key = do
+	g <- Annex.gitRepo
+	let file = gitAnnexLocation g 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
+
+
+checkKeyNumCopies :: Key -> Maybe FilePath -> Maybe Int -> Annex Bool
+checkKeyNumCopies key file numcopies = do
+	needed <- getNumCopies numcopies
+	locations <- keyLocations key
+	untrusted <- trustGet UnTrusted
+	let untrustedlocations = intersect untrusted locations
+	let safelocations = filter (`notElem` untrusted) locations
+	let present = length safelocations
+	if present < needed
+		then do
+			ppuuids <- Remote.prettyPrintUUIDs untrustedlocations
+			warning $ missingNote (filename file key) present needed ppuuids
+			return False
+		else return True
+	where
+		filename Nothing k = show k
+		filename (Just f) _ = f
+
+missingNote :: String -> Int -> Int -> String -> String
+missingNote file 0 _ [] = 
+		"** No known copies exist of " ++ file
+missingNote file 0 _ untrusted =
+		"Only these untrusted locations may have copies of " ++ file ++
+		"\n" ++ untrusted ++
+		"Back it up to trusted locations with git-annex copy."
+missingNote file present needed [] =
+		"Only " ++ show present ++ " of " ++ show needed ++ 
+		" trustworthy copies exist of " ++ file ++
+		"\nBack it up with git-annex copy."
+missingNote file present needed untrusted = 
+		missingNote file present needed [] ++
+		"\nThe following untrusted locations may also have copies: " ++
+		"\n" ++ untrusted