Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tag: 0.09
Fetching contributors…

Cannot retrieve contributors at this time

file 161 lines (148 sloc) 4.951 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161
{- 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.
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}

module Backend (
list,
storeFileKey,
retrieveKeyFile,
removeKey,
hasKey,
fsckKey,
lookupFile,
chooseBackends,
keyBackend
) where

import Control.Monad.State
import System.IO.Error (try)
import System.FilePath
import System.Posix.Files

import Locations
import qualified GitRepo as Git
import qualified Annex
import Types
import qualified TypeInternals as Internals
import Messages

{- List of backends in the order to try them when storing a new key. -}
list :: Annex [Backend]
list = do
l <- Annex.backends -- list is cached here
if not $ null l
then return l
else do
bs <- Annex.supportedBackends
g <- Annex.gitRepo
let defaults = parseBackendList bs $ Git.configGet g "annex.backends" ""
backendflag <- Annex.flagGet "backend"
let l' = if not $ null backendflag
then (lookupBackendName bs backendflag):defaults
else defaults
Annex.backendsChange l'
return l'
where
parseBackendList bs s =
if null s
then bs
else map (lookupBackendName bs) $ words s

{- Looks up a backend in a list. May fail if unknown. -}
lookupBackendName :: [Backend] -> String -> Backend
lookupBackendName bs s =
case maybeLookupBackendName bs s of
Just b -> b
Nothing -> error $ "unknown backend " ++ s
maybeLookupBackendName :: [Backend] -> String -> Maybe Backend
maybeLookupBackendName bs s =
if 1 /= length matches
then Nothing
else Just $ head matches
where matches = filter (\b -> s == Internals.name b) bs

{- Attempts to store a file in one of the backends. -}
storeFileKey :: FilePath -> Maybe Backend -> Annex (Maybe (Key, Backend))
storeFileKey file trybackend = do
bs <- list
let bs' = case trybackend of
Nothing -> bs
Just backend -> backend:bs
storeFileKey' bs' file
storeFileKey' :: [Backend] -> FilePath -> Annex (Maybe (Key, Backend))
storeFileKey' [] _ = return Nothing
storeFileKey' (b:bs) file = do
result <- (Internals.getKey b) file
case result of
Nothing -> nextbackend
Just key -> do
stored <- (Internals.storeFileKey b) file key
if (not stored)
then nextbackend
else return $ Just (key, b)
where
nextbackend = storeFileKey' bs file

{- Attempts to retrieve an key from one of the backends, saving it to
- a specified location. -}
retrieveKeyFile :: Backend -> Key -> FilePath -> Annex Bool
retrieveKeyFile backend key dest = (Internals.retrieveKeyFile backend) key dest

{- Removes a key from a backend. -}
removeKey :: Backend -> Key -> Annex Bool
removeKey backend key = (Internals.removeKey backend) key

{- Checks if a key is present in its backend. -}
hasKey :: Key -> Annex Bool
hasKey key = do
backend <- keyBackend key
(Internals.hasKey backend) key

{- Checks a key's backend for problems. -}
fsckKey :: Backend -> Key -> Annex Bool
fsckKey backend key = (Internals.fsckKey backend) key

{- Looks up the key and backend corresponding to an annexed file,
- by examining what the file symlinks to. -}
lookupFile :: FilePath -> Annex (Maybe (Key, Backend))
lookupFile file = do
bs <- Annex.supportedBackends
tl <- liftIO $ try getsymlink
case tl of
Left _ -> return Nothing
Right l -> makekey bs l
where
getsymlink = do
l <- readSymbolicLink file
return $ takeFileName l
makekey bs l =
case maybeLookupBackendName bs bname of
Nothing -> do
unless (null kname || null bname) $
warning skip
return Nothing
Just backend -> return $ Just (k, backend)
where
k = fileKey l
bname = backendName k
kname = keyName k
skip = "skipping " ++ file ++
" (unknown backend " ++ bname ++ ")"

{- Looks up the backends that should be used for each file in a list.
- That can be configured on a per-file basis in the gitattributes file.
-}
chooseBackends :: [FilePath] -> Annex [(FilePath, Maybe Backend)]
chooseBackends fs = do
g <- Annex.gitRepo
bs <- Annex.supportedBackends
pairs <- liftIO $ Git.checkAttr g "git-annex-backend" fs
return $ map (\(f,b) -> (f, maybeLookupBackendName bs b)) pairs

{- Returns the backend to use for a key. -}
keyBackend :: Key -> Annex Backend
keyBackend key = do
bs <- Annex.supportedBackends
return $ lookupBackendName bs $ backendName key
Something went wrong with that request. Please try again.