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:
parent
12cdc96216
commit
c43e3b5c78
3 changed files with 43 additions and 29 deletions
40
Backend.hs
40
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'
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue