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

This commit is contained in:
Joey Hess 2011-10-14 18:17:46 -04:00
parent 3e07780bf8
commit 9fa9214106
6 changed files with 44 additions and 8 deletions

20
Git.hs
View file

@ -48,8 +48,10 @@ module Git (
attributes, attributes,
remotes, remotes,
remotesAdd, remotesAdd,
genRemote,
repoRemoteName, repoRemoteName,
repoRemoteNameSet, repoRemoteNameSet,
repoRemoteNameFromKey,
checkAttr, checkAttr,
decodeGitFile, decodeGitFile,
encodeGitFile, encodeGitFile,
@ -185,10 +187,14 @@ repoRemoteName :: Repo -> Maybe String
repoRemoteName Repo { remoteName = Just name } = Just name repoRemoteName Repo { remoteName = Just name } = Just name
repoRemoteName _ = Nothing 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 {- Sets the name of a remote based on the git config key, such as
"remote.foo.url". -} "remote.foo.url". -}
repoRemoteNameSet :: Repo -> String -> Repo repoRemoteNameFromKey :: Repo -> String -> Repo
repoRemoteNameSet r k = r { remoteName = Just basename } repoRemoteNameFromKey r k = repoRemoteNameSet r basename
where where
basename = join "." $ reverse $ drop 1 $ basename = join "." $ reverse $ drop 1 $
reverse $ drop 1 $ split "." k reverse $ drop 1 $ split "." k
@ -501,8 +507,14 @@ configRemotes repo = mapM construct remotepairs
remotepairs = filterkeys isremote remotepairs = filterkeys isremote
isremote k = startswith "remote." k && endswith ".url" k isremote k = startswith "remote." k && endswith ".url" k
construct (k,v) = do construct (k,v) = do
r <- gen $ calcloc v r <- genRemote repo v
return $ repoRemoteNameSet r k 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 gen v
| scpstyle v = repoFromUrl $ scptourl v | scpstyle v = repoFromUrl $ scptourl v
| isURI v = repoFromUrl v | isURI v = repoFromUrl v

View file

@ -34,7 +34,18 @@ remote = RemoteType {
list :: Annex [Git.Repo] list :: Annex [Git.Repo]
list = do list = do
g <- gitRepo 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 :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
gen r u _ = do gen r u _ = do

View file

@ -24,7 +24,7 @@ findSpecialRemotes s = do
return $ map construct $ remotepairs g return $ map construct $ remotepairs g
where where
remotepairs r = M.toList $ M.filterWithKey match $ Git.configMap r 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 match k _ = startswith "remote." k && endswith (".annex-"++s) k
{- Sets up configuration for a special remote in .git/config. -} {- Sets up configuration for a special remote in .git/config. -}

View file

@ -33,7 +33,7 @@ remote = RemoteType {
-- (If the web should cease to exist, remove this module and redistribute -- (If the web should cease to exist, remove this module and redistribute
-- a new release to the survivors by carrier pigeon.) -- a new release to the survivors by carrier pigeon.)
list :: Annex [Git.Repo] 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. -- Dummy uuid for the whole web. Do not alter.
webUUID :: UUID webUUID :: UUID

7
debian/changelog vendored
View file

@ -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 git-annex (3.20111011) unstable; urgency=low
* This version of git-annex only works with git 1.7.7 and newer. * This version of git-annex only works with git 1.7.7 and newer.

View file

@ -501,6 +501,12 @@ Here are all the supported configuration settings.
Or, it could be used if the network connection between two Or, it could be used if the network connection between two
repositories is too slow to be used normally. 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` * `remote.<name>.annex-uuid`
git-annex caches UUIDs of remote repositories here. git-annex caches UUIDs of remote repositories here.