diff options
author | Joey Hess <joey@kitenet.net> | 2011-03-30 14:32:08 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2011-03-30 14:32:08 -0400 |
commit | 8b6ef15835087c2b266df624bb24f5e30154dddb (patch) | |
tree | bc6e190157b63de710b69cc3f1a95cdeaeaa9579 | |
parent | f379169d7adb8e10a2f442fab63979a9817b16f6 (diff) |
allow directory remotes to be in different locations
Two machines might have access to the same directory remote on different
paths, so don't include the path in its persistent config, instead use
the git config to record it.
-rw-r--r-- | Remote/Directory.hs | 68 | ||||
-rw-r--r-- | Remote/S3real.hs | 2 | ||||
-rw-r--r-- | Remote/Special.hs | 8 |
3 files changed, 35 insertions, 43 deletions
diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 12736e050..919dcc295 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -10,7 +10,6 @@ module Remote.Directory (remote) where import IO import Control.Exception.Extensible (IOException) import qualified Data.Map as M -import Data.Maybe import Control.Monad (when) import Control.Monad.State (liftIO) import System.Directory (doesDirectoryExist, doesFileExist, removeFile) @@ -21,9 +20,9 @@ import Types import qualified GitRepo as Git import qualified Annex import UUID -import Utility import Locations import CopyFile +import Config import Remote.Special remote :: RemoteType Annex @@ -35,19 +34,19 @@ remote = RemoteType { } gen :: Git.Repo -> UUID -> Cost -> Maybe (M.Map String String) -> Annex (Remote Annex) -gen r u cst c = return this - where - this = Remote { - uuid = u, - cost = cst, - name = Git.repoDescribe r, - storeKey = store this, - retrieveKeyFile = retrieve this, - removeKey = remove this, - hasKey = checkPresent this, - hasKeyCheap = True, - config = c - } +gen r u cst _ = do + dir <- getConfig r "directory" (error "missing directory") + return $ Remote { + uuid = u, + cost = cst, + name = Git.repoDescribe r, + storeKey = store dir, + retrieveKeyFile = retrieve dir, + removeKey = remove dir, + hasKey = checkPresent dir, + hasKeyCheap = True, + config = Nothing + } directorySetup :: UUID -> M.Map String String -> Annex (M.Map String String) directorySetup u c = do @@ -58,33 +57,26 @@ directorySetup u c = do e <- liftIO $ doesDirectoryExist dir when (not e) $ error $ "Directory does not exist: " ++ dir - gitConfigSpecialRemote "directory" u c - g <- Annex.gitRepo - liftIO $ do - Git.run g "config" [Param (configsetting "annex-directory"), Param "true"] - Git.run g "config" [Param (configsetting "annex-uuid"), Param u] - return c - where - remotename = fromJust (M.lookup "name" c) - configsetting s = "remote." ++ remotename ++ "." ++ s + -- The directory is stored in git config, not in this remote's + -- persistant state, so it can vary between hosts. + gitConfigSpecialRemote u c "directory" dir + return $ M.delete "directory" c -dirKey :: Remote Annex -> Key -> FilePath -dirKey r k = dir </> show k - where - dir = fromJust $ M.lookup "directory" $ fromJust $ config r +dirKey :: FilePath -> Key -> FilePath +dirKey d k = d </> show k -store :: Remote Annex -> Key -> Annex Bool -store r k = do +store :: FilePath -> Key -> Annex Bool +store d k = do g <- Annex.gitRepo - liftIO $ copyFile (gitAnnexLocation g k) (dirKey r k) + liftIO $ copyFile (gitAnnexLocation g k) (dirKey d k) -retrieve :: Remote Annex -> Key -> FilePath -> Annex Bool -retrieve r k f = liftIO $ copyFile (dirKey r k) f +retrieve :: FilePath -> Key -> FilePath -> Annex Bool +retrieve d k f = liftIO $ copyFile (dirKey d k) f -remove :: Remote Annex -> Key -> Annex Bool -remove r k = liftIO $ catch - (removeFile (dirKey r k) >> return True) +remove :: FilePath -> Key -> Annex Bool +remove d k = liftIO $ catch + (removeFile (dirKey d k) >> return True) (const $ return False) -checkPresent :: Remote Annex -> Key -> Annex (Either IOException Bool) -checkPresent r k = liftIO $ try $ doesFileExist (dirKey r k) +checkPresent :: FilePath -> Key -> Annex (Either IOException Bool) +checkPresent d k = liftIO $ try $ doesFileExist (dirKey d k) diff --git a/Remote/S3real.hs b/Remote/S3real.hs index 4380231fd..0827c4fbf 100644 --- a/Remote/S3real.hs +++ b/Remote/S3real.hs @@ -88,7 +88,7 @@ s3Setup u c = do Right _ -> return () Left err -> error $ prettyReqError err - gitConfigSpecialRemote "s3" u fullconfig + gitConfigSpecialRemote u fullconfig "s3" "true" return fullconfig where remotename = fromJust (M.lookup "name" c) diff --git a/Remote/Special.hs b/Remote/Special.hs index d985eef6f..b5d5a137f 100644 --- a/Remote/Special.hs +++ b/Remote/Special.hs @@ -32,12 +32,12 @@ findSpecialRemotes s = do match k _ = startswith "remote." k && endswith (".annex-"++s) k {- Sets up configuration for a special remote in .git/config. -} -gitConfigSpecialRemote :: String -> UUID -> M.Map String String -> Annex () -gitConfigSpecialRemote s u c = do +gitConfigSpecialRemote :: UUID -> M.Map String String -> String -> String -> Annex () +gitConfigSpecialRemote u c k v = do g <- Annex.gitRepo liftIO $ do - Git.run g "config" [Param (configsetting $ "annex-"++s), Param "true"] + Git.run g "config" [Param (configsetting $ "annex-"++k), Param v] Git.run g "config" [Param (configsetting $ "annex-uuid"), Param u] where remotename = fromJust (M.lookup "name" c) - configsetting v = "remote." ++ remotename ++ "." ++ v + configsetting s = "remote." ++ remotename ++ "." ++ s |