check key size when available, no matter the backend

Now that SHA and other backends can have size info, fsck should check it
whenever available.

3 files changed, 43 insertions, 29 deletions

diff --git a/Backend.hs b/Backend.hs
index cd14ce50e..d7334f144 100644
--- a/Backend.hs
+++ b/Backend.hs
@@ -35,6 +35,7 @@ import Control.Monad.State
 import System.IO.Error (try)
 import System.FilePath
 import System.Posix.Files
+import System.Directory
 
 import Locations
 import qualified GitRepo as Git
@@ -43,6 +44,8 @@ import Types
 import Key
 import qualified BackendClass as B
 import Messages
+import Content
+import DataUnits
 
 {- List of backends in the order to try them when storing a new key. -}
 list :: Annex [Backend Annex]
@@ -120,9 +123,12 @@ hasKey key = do
 	backend <- keyBackend key
 	(B.hasKey backend) key
 
-{- Checks a key's backend for problems. -}
+{- Checks a key for problems. -}
 fsckKey :: Backend Annex -> Key -> Maybe FilePath -> Maybe Int -> Annex Bool
-fsckKey backend key file numcopies = (B.fsckKey backend) key file numcopies
+fsckKey backend key file numcopies = do
+	size_ok <- checkKeySize key
+	backend_ok <-(B.fsckKey backend) key file numcopies
+	return $ size_ok && backend_ok
 
 {- Looks up the key and backend corresponding to an annexed file,
  - by examining what the file symlinks to. -}
@@ -168,3 +174,33 @@ keyBackend :: Key -> Annex (Backend Annex)
 keyBackend key = do
 	bs <- Annex.getState Annex.supportedBackends
 	return $ lookupBackendName bs $ keyBackendName key
+
+{- 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, 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 $ badsizeNote dest size size'
+					return False
+
+badsizeNote :: FilePath -> Integer -> Integer -> String
+badsizeNote dest expected got = "Bad file size (" ++ aside ++ "); moved to " ++ dest
+	where
+		expected' = roughSize True expected
+		got' = roughSize True got
+		aside = 
+			if expected' == got'
+				then show expected ++ " not " ++ show got
+				else expected' ++ " not " ++ got'
diff --git a/Backend/File.hs b/Backend/File.hs
index a5e243199..a6d42eabd 100644
--- a/Backend/File.hs
+++ b/Backend/File.hs
@@ -38,7 +38,7 @@ backend = Backend {
 	retrieveKeyFile = copyKeyFile,
 	removeKey = checkRemoveKey,
 	hasKey = inAnnex,
-	fsckKey = mustProvide
+	fsckKey = checkKeyOnly
 }
 
 mustProvide :: a
@@ -172,6 +172,9 @@ checkKey a key file numcopies = do
 	copies_ok <- checkKeyNumCopies key file numcopies
 	return $ a_ok && copies_ok
 
+checkKeyOnly :: Key -> Maybe FilePath -> Maybe Int -> Annex Bool
+checkKeyOnly = checkKey (\_ -> return True)
+
 checkKeyNumCopies :: Key -> Maybe FilePath -> Maybe Int -> Annex Bool
 checkKeyNumCopies key file numcopies = do
 	needed <- getNumCopies numcopies
diff --git a/Backend/WORM.hs b/Backend/WORM.hs
index a011995da..b33c60763 100644
--- a/Backend/WORM.hs
+++ b/Backend/WORM.hs
@@ -10,15 +10,9 @@ module Backend.WORM (backends) where
 import Control.Monad.State
 import System.FilePath
 import System.Posix.Files
-import System.Directory
-import Data.Maybe
 
 import qualified Backend.File
 import BackendClass
-import Locations
-import qualified Annex
-import Content
-import Messages
 import Types
 import Key
 
@@ -28,8 +22,7 @@ backends = [backend]
 backend :: Backend Annex
 backend = Backend.File.backend {
 	name = "WORM",
-	getKey = keyValue,
-	fsckKey = Backend.File.checkKey checkKeySize
+	getKey = keyValue
 }
 
 {- The key includes the file size, modification time, and the
@@ -48,21 +41,3 @@ keyValue file = do
 		keySize = Just $ fromIntegral $ fileSize stat,
 		keyMtime = Just $ modificationTime stat
 	}
-
-{- The size of the data for a key is checked against the size encoded in
- - the key's metadata. -}
-checkKeySize :: Key -> Annex Bool
-checkKeySize key = do
-	g <- Annex.gitRepo
-	let file = gitAnnexLocation g key
-	present <- liftIO $ doesFileExist file
-	if not present
-		then return True
-		else do
-			s <- liftIO $ getFileStatus file
-			if fromIntegral (fileSize s) == fromJust (keySize key)
-				then return True
-				else do
-					dest <- moveBad key
-					warning $ "Bad file size; moved to " ++ dest
-					return False