A remote can have a annexUrl configured, that is used by git-annex instead of its usual url. (Similar to pushUrl.)

6 files changed, 44 insertions, 8 deletions

diff --git a/Git.hs b/Git.hs
index 044fc08ae..836e063c2 100644
--- a/Git.hs
+++ b/Git.hs
@@ -48,8 +48,10 @@ module Git (
 	attributes,
 	remotes,
 	remotesAdd,
+	genRemote,
 	repoRemoteName,
 	repoRemoteNameSet,
+	repoRemoteNameFromKey,
 	checkAttr,
 	decodeGitFile,
 	encodeGitFile,
@@ -185,10 +187,14 @@ repoRemoteName :: Repo -> Maybe String
 repoRemoteName Repo { remoteName = Just name } = Just name
 repoRemoteName _ = Nothing
 
+{- Sets the name of a remote. -}
+repoRemoteNameSet :: Repo -> String -> Repo
+repoRemoteNameSet r n = r { remoteName = Just n }
+
 {- Sets the name of a remote based on the git config key, such as
    "remote.foo.url". -}
-repoRemoteNameSet :: Repo -> String -> Repo
-repoRemoteNameSet r k = r { remoteName = Just basename }
+repoRemoteNameFromKey :: Repo -> String -> Repo
+repoRemoteNameFromKey r k = repoRemoteNameSet r basename
 	where
 		basename = join "." $ reverse $ drop 1 $
 				reverse $ drop 1 $ split "." k
@@ -501,9 +507,15 @@ configRemotes repo = mapM construct remotepairs
 		remotepairs = filterkeys isremote
 		isremote k = startswith "remote." k && endswith ".url" k
 		construct (k,v) = do
-			r <- gen $ calcloc v
-			return $ repoRemoteNameSet r k
-		gen v
+			r <- genRemote repo v
+			return $ repoRemoteNameFromKey r k
+
+{- Generates one of a repo's remotes using a given location (ie, an url). -}
+genRemote :: Repo -> String -> IO Repo
+genRemote repo = gen . calcloc
+	where
+		filterconfig f = filter f $ M.toList $ config repo
+		gen v	
 			| scpstyle v = repoFromUrl $ scptourl v
 			| isURI v = repoFromUrl v
 			| otherwise = repoFromRemotePath v repo
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 183fcd854..e9919e636 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -34,7 +34,18 @@ remote = RemoteType {
 list :: Annex [Git.Repo]
 list = do
 	g <- gitRepo
-	return $ Git.remotes g
+	let c = Git.configMap g
+	mapM (tweakurl c) $ Git.remotes g
+	where
+		annexurl n = "remote." ++ n ++ ".annexurl"
+		tweakurl c r = do
+			let n = fromJust $ Git.repoRemoteName r
+			case M.lookup (annexurl n) c of
+				Nothing -> return r
+				Just url -> do
+					g <- gitRepo
+					r' <- liftIO $ Git.genRemote g url
+					return $ Git.repoRemoteNameSet r' n
 
 gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
 gen r u _ = do
diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs
index 1fbd7b19e..5f66e8cd9 100644
--- a/Remote/Helper/Special.hs
+++ b/Remote/Helper/Special.hs
@@ -24,7 +24,7 @@ findSpecialRemotes s = do
 	return $ map construct $ remotepairs g
 	where
 		remotepairs r = M.toList $ M.filterWithKey match $ Git.configMap r
-		construct (k,_) = Git.repoRemoteNameSet Git.repoFromUnknown k
+		construct (k,_) = Git.repoRemoteNameFromKey Git.repoFromUnknown k
 		match k _ = startswith "remote." k && endswith (".annex-"++s) k
 
 {- Sets up configuration for a special remote in .git/config. -}
diff --git a/Remote/Web.hs b/Remote/Web.hs
index 30a1ff008..ed9c94909 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -33,7 +33,7 @@ remote = RemoteType {
 -- (If the web should cease to exist, remove this module and redistribute
 -- a new release to the survivors by carrier pigeon.)
 list :: Annex [Git.Repo]
-list = return [Git.repoRemoteNameSet Git.repoFromUnknown "remote.web.dummy"]
+list = return [Git.repoRemoteNameSet Git.repoFromUnknown "web"]
 
 -- Dummy uuid for the whole web. Do not alter.
 webUUID :: UUID
diff --git a/debian/changelog b/debian/changelog
index c4e53e179..6e3450a92 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,10 @@
+git-annex (3.20111012) UNRELEASED; urgency=low
+
+  * A remote can have a annexUrl configured, that is used by git-annex
+    instead of its usual url. (Similar to pushUrl.)
+
+ -- Joey Hess <joeyh@debian.org>  Fri, 14 Oct 2011 18:15:20 -0400
+
 git-annex (3.20111011) unstable; urgency=low
 
   * This version of git-annex only works with git 1.7.7 and newer.
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index db19e9f7a..eefedbfbf 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -501,6 +501,12 @@ Here are all the supported configuration settings.
   Or, it could be used if the network connection between two
   repositories is too slow to be used normally.
 
+* `remote.<name>.annexUrl`
+
+  Can be used to specify a different url than the regular `remote.<name>.url`
+  for git-annex to use when talking with the remote. Similar to the `pushUrl`
+  used by git-push.
+
 * `remote.<name>.annex-uuid`
 
   git-annex caches UUIDs of remote repositories here.