diff --git a/Annex.hs b/Annex.hs index ad94758c50..882ed2761b 100644 --- a/Annex.hs +++ b/Annex.hs @@ -18,20 +18,38 @@ import LocationLog startAnnex :: IO State startAnnex = do r <- currentRepo + config <- getConfig r gitPrep r - -- TODO query git repo for configuration - return State { repo = r, backends = supportedBackends } + return State { + repo = r, + gitconfig = config + } + +{- Query the git repo for relevant configuration settings. -} +getConfig :: GitRepo -> IO GitConfig +getConfig repo = do + -- a name can be configured, if none is, use the repository path + name <- gitConfigGet "annex.name" (top repo) + -- default number of copies to keep of file contents is 1 + numcopies <- gitConfigGet "annex.numcopies" "1" + backends <- gitConfigGet "annex.backends" "" + + return GitConfig { + annex_name = name, + annex_numcopies = read numcopies, + annex_backends = parseBackendList backends + } {- Annexes a file, storing it in a backend, and then moving it into - the annex directory and setting up the symlink pointing to its content. -} annexFile :: State -> FilePath -> IO () annexFile state file = do - alreadyannexed <- lookupBackend (backends state) (repo state) file + alreadyannexed <- lookupBackend backends (repo state) file case (alreadyannexed) of Just _ -> error $ "already annexed: " ++ file Nothing -> do checkLegal file - stored <- storeFile (backends state) (repo state) file + stored <- storeFile (annex_backends $ gitconfig state) (repo state) file case (stored) of Nothing -> error $ "no backend could store: " ++ file Just key -> symlink key @@ -47,15 +65,16 @@ annexFile state file = do if ((isSymbolicLink s) || (not $ isRegularFile s)) then error $ "not a regular file: " ++ file else return () + backends = annex_backends $ gitconfig state {- Inverse of annexFile. -} unannexFile :: State -> FilePath -> IO () unannexFile state file = do - alreadyannexed <- lookupBackend (backends state) (repo state) file + alreadyannexed <- lookupBackend backends (repo state) file case (alreadyannexed) of Nothing -> error $ "not annexed " ++ file Just _ -> do - mkey <- dropFile (backends state) (repo state) file + mkey <- dropFile backends (repo state) file case (mkey) of Nothing -> return () Just key -> do @@ -63,6 +82,8 @@ unannexFile state file = do removeFile file renameFile src file return () + where + backends = annex_backends $ gitconfig state {- Sets up a git repo for git-annex. May be called repeatedly. -} gitPrep :: GitRepo -> IO () diff --git a/BackendList.hs b/BackendList.hs index c744949b6c..77e4bd817f 100644 --- a/BackendList.hs +++ b/BackendList.hs @@ -4,6 +4,7 @@ module BackendList where -- When adding a new backend, import it here and add it to the list. +import Types import qualified BackendFile import qualified BackendChecksum import qualified BackendUrl @@ -12,3 +13,20 @@ supportedBackends = , BackendChecksum.backend , BackendUrl.backend ] + +{- Parses a string with a list of backend names into + - a list of Backend objects. If the list is empty, + - defaults to supportedBackends. -} +parseBackendList :: String -> [Backend] +parseBackendList s = + if (length s == 0) + then supportedBackends + else map (lookupBackendName) $ words s + +{- Looks up a supported backed by name. -} +lookupBackendName :: String -> Backend +lookupBackendName s = + if ((length matches) /= 1) + then error $ "unknown backend " ++ s + else matches !! 0 + where matches = filter (\b -> s == name b) supportedBackends diff --git a/GitRepo.hs b/GitRepo.hs index ef76fb9766..3a8a8110dd 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -5,7 +5,10 @@ module GitRepo where import Directory import System.Directory import System.Path +import System.Cmd.Utils +import System.IO import Data.String.Utils +import Control.Exception import Utility import Types @@ -14,11 +17,9 @@ gitRepo :: FilePath -> IO GitRepo gitRepo dir = do b <- isBareRepo dir - -- TOOD query repo for configuration settings; other repositories; etc return GitRepo { top = dir, - bare = b, - remotes = [] + bare = b } {- Path to a repository's gitattributes file. -} @@ -53,10 +54,19 @@ gitRelative repo file = drop (length absrepo) absfile Nothing -> error $ file ++ " is not located inside git repository " ++ absrepo {- Stages a changed file in git's index. -} +gitAdd :: GitRepo -> FilePath -> IO () gitAdd repo file = do -- TODO return () +{- Queries git-config. -} +gitConfigGet :: String -> String -> IO String +gitConfigGet name defaultValue = + handle ((\_ -> return defaultValue)::SomeException -> IO String) $ + pOpen ReadFromPipe "git" ["config", "--get", name] $ \h -> do + ret <- hGetLine h + return ret + {- Finds the current git repository, which may be in a parent directory. -} currentRepo :: IO GitRepo currentRepo = do diff --git a/Types.hs b/Types.hs index 6e3727e25a..5c5a428d59 100644 --- a/Types.hs +++ b/Types.hs @@ -23,12 +23,17 @@ data Backend = Backend { -- a git repository data GitRepo = GitRepo { top :: FilePath, - bare :: Bool, - remotes :: [GitRepo] + bare :: Bool } -- git-annex's runtime state data State = State { repo :: GitRepo, - backends :: [Backend] + gitconfig :: GitConfig +} + +data GitConfig = GitConfig { + annex_name :: String, + annex_numcopies :: Int, + annex_backends :: [Backend] } diff --git a/git-annex.mdwn b/git-annex.mdwn index 2996a90b51..6bfdd57c7f 100644 --- a/git-annex.mdwn +++ b/git-annex.mdwn @@ -124,8 +124,9 @@ so the lines may be in arbitrary order, but it will never conflict.) ## configuration * `annex.numcopies` -- number of copies of files to keep -* `annex.backend` -- name of the default key/value backend to use to - store new files +* `annex.backends` -- space-separated list of names of + the key/value backends to use. The first listed is used to store + new files. * `annex.name` -- allows specifying a unique name for this repository. If not specified, the name is derived from its directory's location and the hostname. When a repository is on removable media it is useful to give @@ -145,11 +146,15 @@ If the symlink to annexed content is relative, moving it to a subdir will break it. But it it's absolute, moving the git repo (or mounting its drive elsewhere) will break it. Either: -* Use relative links and need `git annex mv` to move (or post-commit +* Use relative links and need `git annex --mv` to move (or post-commit hook that caches moves and updates links). * Use absolute links and need `git annex fixlinks` when location changes; note that would also mean that git would see the symlink targets changed - and want to commit the change. + and want to commit the change. And, other clones of the repo would + diverge and there would be conflicts on the symlink text. Ugh. + +Hard links are not an option, because git would then happily commit the +file content. Amoung other reasons.. ### free space determination