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.

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
+gen r u cst _ = do
-	where
+	dir <- getConfig r "directory" (error "missing directory")
-		this = Remote {
+	return $ Remote {
-			uuid = u,
+		uuid = u,
-			cost = cst,
+		cost = cst,
-			name = Git.repoDescribe r,
+		name = Git.repoDescribe r,
-	 		storeKey = store this,
+ 		storeKey = store dir,
-			retrieveKeyFile = retrieve this,
+		retrieveKeyFile = retrieve dir,
-			removeKey = remove this,
+		removeKey = remove dir,
-			hasKey = checkPresent this,
+		hasKey = checkPresent dir,
-			hasKeyCheap = True,
+		hasKeyCheap = True,
-			config = c
+		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
+	-- 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 :: FilePath -> Key -> FilePath
+dirKey d k = d </> show k
+
+store :: FilePath -> Key -> Annex Bool
+store d k = do
 	g <- Annex.gitRepo
-	liftIO $ do
+	liftIO $ copyFile (gitAnnexLocation g k) (dirKey d k)
-		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
 
-dirKey :: Remote Annex -> Key -> FilePath
+retrieve :: FilePath -> Key -> FilePath -> Annex Bool
-dirKey r k = dir </> show k
+retrieve d k f = liftIO $ copyFile (dirKey d k) f
-	where
-		dir = fromJust $ M.lookup "directory" $ fromJust $ config r
 
-store :: Remote Annex -> Key -> Annex Bool
+remove :: FilePath -> Key -> Annex Bool
-store r k = do
+remove d k = liftIO $ catch
-	g <- Annex.gitRepo
+	(removeFile (dirKey d k) >> return True)
-	liftIO $ copyFile (gitAnnexLocation g k) (dirKey r k)
-
-retrieve :: Remote Annex -> Key -> FilePath -> Annex Bool
-retrieve r k f = liftIO $ copyFile (dirKey r k) f
-
-remove :: Remote Annex -> Key -> Annex Bool
-remove r k = liftIO $ catch
-	(removeFile (dirKey r k) >> return True)
 	(const $ return False)
 
-checkPresent :: Remote Annex -> Key -> Annex (Either IOException Bool)
+checkPresent :: FilePath -> Key -> Annex (Either IOException Bool)
-checkPresent r k = liftIO $ try $ doesFileExist (dirKey r k)
+checkPresent d k = liftIO $ try $ doesFileExist (dirKey d k)

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)

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 :: UUID -> M.Map String String -> String -> String -> Annex ()
-gitConfigSpecialRemote s u c = do
+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