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.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'
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
|
||||||
|
|
Loading…
Reference in a new issue