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.
This commit is contained in:
Joey Hess 2011-03-23 02:10:59 -04:00
parent 12cdc96216
commit c43e3b5c78
3 changed files with 43 additions and 29 deletions

View file

@ -35,6 +35,7 @@ import Control.Monad.State
import System.IO.Error (try) import System.IO.Error (try)
import System.FilePath import System.FilePath
import System.Posix.Files import System.Posix.Files
import System.Directory
import Locations import Locations
import qualified GitRepo as Git import qualified GitRepo as Git
@ -43,6 +44,8 @@ import Types
import Key import Key
import qualified BackendClass as B import qualified BackendClass as B
import Messages import Messages
import Content
import DataUnits
{- List of backends in the order to try them when storing a new key. -} {- List of backends in the order to try them when storing a new key. -}
list :: Annex [Backend Annex] list :: Annex [Backend Annex]
@ -120,9 +123,12 @@ hasKey key = do
backend <- keyBackend key backend <- keyBackend key
(B.hasKey backend) 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 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, {- Looks up the key and backend corresponding to an annexed file,
- by examining what the file symlinks to. -} - by examining what the file symlinks to. -}
@ -168,3 +174,33 @@ keyBackend :: Key -> Annex (Backend Annex)
keyBackend key = do keyBackend key = do
bs <- Annex.getState Annex.supportedBackends bs <- Annex.getState Annex.supportedBackends
return $ lookupBackendName bs $ keyBackendName key 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'

View file

@ -38,7 +38,7 @@ backend = Backend {
retrieveKeyFile = copyKeyFile, retrieveKeyFile = copyKeyFile,
removeKey = checkRemoveKey, removeKey = checkRemoveKey,
hasKey = inAnnex, hasKey = inAnnex,
fsckKey = mustProvide fsckKey = checkKeyOnly
} }
mustProvide :: a mustProvide :: a
@ -172,6 +172,9 @@ checkKey a key file numcopies = do
copies_ok <- checkKeyNumCopies key file numcopies copies_ok <- checkKeyNumCopies key file numcopies
return $ a_ok && copies_ok 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 -> Maybe FilePath -> Maybe Int -> Annex Bool
checkKeyNumCopies key file numcopies = do checkKeyNumCopies key file numcopies = do
needed <- getNumCopies numcopies needed <- getNumCopies numcopies

View file

@ -10,15 +10,9 @@ module Backend.WORM (backends) where
import Control.Monad.State import Control.Monad.State
import System.FilePath import System.FilePath
import System.Posix.Files import System.Posix.Files
import System.Directory
import Data.Maybe
import qualified Backend.File import qualified Backend.File
import BackendClass import BackendClass
import Locations
import qualified Annex
import Content
import Messages
import Types import Types
import Key import Key
@ -28,8 +22,7 @@ backends = [backend]
backend :: Backend Annex backend :: Backend Annex
backend = Backend.File.backend { backend = Backend.File.backend {
name = "WORM", name = "WORM",
getKey = keyValue, getKey = keyValue
fsckKey = Backend.File.checkKey checkKeySize
} }
{- The key includes the file size, modification time, and the {- The key includes the file size, modification time, and the
@ -48,21 +41,3 @@ keyValue file = do
keySize = Just $ fromIntegral $ fileSize stat, keySize = Just $ fromIntegral $ fileSize stat,
keyMtime = Just $ modificationTime 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