diff options
Diffstat (limited to 'Backend.hs')
| -rw-r--r-- | Backend.hs | 168 |
1 files changed, 49 insertions, 119 deletions
diff --git a/Backend.hs b/Backend.hs index b1cd4c8f0..cf976d2b8 100644 --- a/Backend.hs +++ b/Backend.hs @@ -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 - -{- 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 + return $ map (\(f,b) -> (f, maybeLookupBackendName b)) pairs -{- 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 |