remove unused backend machinery

The only remaining vestiage of backends is different types of keys. These
are still called "backends", mostly to avoid needing to change user interface
and configuration. But everything to do with storing keys in different
backends was gone; instead different types of remotes are used.

In the refactoring, lots of code was moved out of odd corners like
Backend.File, to closer to where it's used, like Command.Drop and
Command.Fsck. Quite a lot of dead code was removed. Several data structures
became simpler, which may result in better runtime efficiency. There should
be no user-visible changes.
This commit is contained in:
Joey Hess 2011-07-05 18:31:46 -04:00
parent 674768abac
commit 9f1577f746
25 changed files with 308 additions and 445 deletions

View file

@ -1,16 +1,4 @@
{- git-annex key-value storage backends
-
- git-annex uses a key-value abstraction layer to allow files contents to be
- stored in different ways. In theory, any key-value storage system could be
- used to store the file contents, and git-annex would then retrieve them
- as needed and put them in `.git/annex/`.
-
- When a file is annexed, a key is generated from its content and/or metadata.
- This key can later be used to retrieve the file's content (its value). This
- key generation must be stable for a given file content, name, and size.
-
- Multiple pluggable backends are supported, and more than one can be used
- to store different files' contents in a given repository.
{- git-annex key/value backends
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
-
@ -19,15 +7,10 @@
module Backend (
list,
storeFileKey,
retrieveKeyFile,
removeKey,
hasKey,
fsckKey,
upgradableKey,
orderedList,
genKey,
lookupFile,
chooseBackends,
keyBackend,
lookupBackendName,
maybeLookupBackendName
) where
@ -36,7 +19,6 @@ import Control.Monad.State (liftIO, when)
import System.IO.Error (try)
import System.FilePath
import System.Posix.Files
import System.Directory
import Locations
import qualified Git
@ -45,12 +27,20 @@ import Types
import Types.Key
import qualified Types.Backend as B
import Messages
import Content
import DataUnits
-- When adding a new backend, import it here and add it to the list.
import qualified Backend.WORM
import qualified Backend.SHA
list :: [Backend Annex]
list = concat
[ Backend.WORM.backends
, Backend.SHA.backends
]
{- List of backends in the order to try them when storing a new key. -}
list :: Annex [Backend Annex]
list = do
orderedList :: Annex [Backend Annex]
orderedList = do
l <- Annex.getState Annex.backends -- list is cached here
if not $ null l
then return l
@ -59,92 +49,49 @@ list = do
d <- Annex.getState Annex.forcebackend
handle d s
where
parseBackendList l [] = l
parseBackendList bs s = map (lookupBackendName bs) $ words s
parseBackendList [] = list
parseBackendList s = map lookupBackendName $ words s
handle Nothing s = return s
handle (Just "") s = return s
handle (Just name) s = do
bs <- Annex.getState Annex.supportedBackends
let l' = (lookupBackendName bs name):s
let l' = (lookupBackendName name):s
Annex.changeState $ \state -> state { Annex.backends = l' }
return l'
getstandard = do
bs <- Annex.getState Annex.supportedBackends
g <- Annex.gitRepo
return $ parseBackendList bs $
return $ parseBackendList $
Git.configGet g "annex.backends" ""
{- Looks up a backend in a list. May fail if unknown. -}
lookupBackendName :: [Backend Annex] -> String -> Backend Annex
lookupBackendName bs s = maybe unknown id $ maybeLookupBackendName bs s
where
unknown = error $ "unknown backend " ++ s
maybeLookupBackendName :: [Backend Annex] -> String -> Maybe (Backend Annex)
maybeLookupBackendName bs s =
if 1 /= length matches
then Nothing
else Just $ head matches
where matches = filter (\b -> s == B.name b) bs
{- Attempts to store a file in one of the backends. -}
storeFileKey :: FilePath -> Maybe (Backend Annex) -> Annex (Maybe (Key, Backend Annex))
storeFileKey file trybackend = do
bs <- list
{- Generates a key for a file, trying each backend in turn until one
- accepts it. -}
genKey :: FilePath -> Maybe (Backend Annex) -> Annex (Maybe (Key, Backend Annex))
genKey file trybackend = do
bs <- orderedList
let bs' = maybe bs (:bs) trybackend
storeFileKey' bs' file
storeFileKey' :: [Backend Annex] -> FilePath -> Annex (Maybe (Key, Backend Annex))
storeFileKey' [] _ = return Nothing
storeFileKey' (b:bs) file = maybe nextbackend store =<< (B.getKey b) file
where
nextbackend = storeFileKey' bs file
store key = do
stored <- (B.storeFileKey b) file key
if (not stored)
then nextbackend
else return $ Just (key, b)
{- Attempts to retrieve an key from one of the backends, saving it to
- a specified location. -}
retrieveKeyFile :: Backend Annex -> Key -> FilePath -> Annex Bool
retrieveKeyFile backend key dest = (B.retrieveKeyFile backend) key dest
{- Removes a key from a backend. -}
removeKey :: Backend Annex -> Key -> Maybe Int -> Annex Bool
removeKey backend key numcopies = (B.removeKey backend) key numcopies
{- Checks if a key is present in its backend. -}
hasKey :: Key -> Annex Bool
hasKey key = do
backend <- keyBackend key
(B.hasKey backend) key
{- Checks a key for problems. -}
fsckKey :: Backend Annex -> Key -> Maybe FilePath -> Maybe Int -> Annex Bool
fsckKey backend key file numcopies = do
size_ok <- checkKeySize key
backend_ok <-(B.fsckKey backend) key file numcopies
return $ size_ok && backend_ok
{- Checks if a key is upgradable to a newer representation. -}
upgradableKey :: Backend Annex -> Key -> Annex Bool
upgradableKey backend key = (B.upgradableKey backend) key
genKey' bs' file
genKey' :: [Backend Annex] -> FilePath -> Annex (Maybe (Key, Backend Annex))
genKey' [] _ = return Nothing
genKey' (b:bs) file = do
r <- (B.getKey b) file
case r of
Nothing -> genKey' bs file
Just k -> return $ Just (k, b)
{- Looks up the key and backend corresponding to an annexed file,
- by examining what the file symlinks to. -}
lookupFile :: FilePath -> Annex (Maybe (Key, Backend Annex))
lookupFile file = do
bs <- Annex.getState Annex.supportedBackends
tl <- liftIO $ try getsymlink
case tl of
Left _ -> return Nothing
Right l -> makekey bs l
Right l -> makekey l
where
getsymlink = do
l <- readSymbolicLink file
return $ takeFileName l
makekey bs l = maybe (return Nothing) (makeret bs l) (fileKey l)
makeret bs l k =
case maybeLookupBackendName bs bname of
makekey l = maybe (return Nothing) (makeret l) (fileKey l)
makeret l k =
case maybeLookupBackendName bname of
Just backend -> return $ Just (k, backend)
Nothing -> do
when (isLinkToAnnex l) $
@ -164,37 +111,20 @@ chooseBackends fs = do
forced <- Annex.getState Annex.forcebackend
if forced /= Nothing
then do
l <- list
l <- orderedList
return $ map (\f -> (f, Just $ head l)) fs
else do
bs <- Annex.getState Annex.supportedBackends
pairs <- liftIO $ Git.checkAttr g "annex.backend" fs
return $ map (\(f,b) -> (f, maybeLookupBackendName bs b)) pairs
return $ map (\(f,b) -> (f, maybeLookupBackendName b)) pairs
{- Returns the backend to use for a key. -}
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 $ "Bad file size (" ++
compareSizes storageUnits True size size' ++
"); moved to " ++ dest
return False
{- Looks up a backend by name. May fail if unknown. -}
lookupBackendName :: String -> Backend Annex
lookupBackendName s = maybe unknown id $ maybeLookupBackendName s
where
unknown = error $ "unknown backend " ++ s
maybeLookupBackendName :: String -> Maybe (Backend Annex)
maybeLookupBackendName s =
if 1 /= length matches
then Nothing
else Just $ head matches
where matches = filter (\b -> s == B.name b) list