diff options
| -rw-r--r-- | Backend.hs | 40 | ||||
| -rw-r--r-- | Backend/File.hs | 5 | ||||
| -rw-r--r-- | Backend/WORM.hs | 27 |
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 |