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:
parent
3e07780bf8
commit
9fa9214106
6 changed files with 44 additions and 8 deletions
20
Git.hs
20
Git.hs
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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. -}
|
||||||
|
|
|
@ -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
7
debian/changelog
vendored
|
@ -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.
|
||||||
|
|
|
@ -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.
|
||||||
|
|
Loading…
Reference in a new issue