annexInsteadOf config
Added config `url.<base>.annexInsteadOf` corresponding to git's `url.<base>.pushInsteadOf`, to configure the urls to use for accessing the git-annex repositories on a server without needing to configure remote.name.annexUrl in each repository. While one use case for this would be rewriting urls to use annex+http, I decided not to add any kind of special case for that. So while git-annex p2phttp, when serving multiple repositories, needs an url of eg "annex+http://example.com/git-annex/ for each of them, rewriting an url like "https://example.com/git/foo/bar" with this config set to "https://example.com/git/" will result in eg "annex+http://example.com/git-annex/foo/bar", which p2phttp does not support. That seems better dealt with in either git-annex p2phttp or a http middleware, rather than complicating the config with a special case for annex+http. Anyway, there are other use cases for this that don't involve annex+http.
This commit is contained in:
parent
0404968d10
commit
dd052dcba1
7 changed files with 79 additions and 41 deletions
|
@ -89,7 +89,7 @@ remoteLocationIsSshUrl _ = False
|
|||
parseRemoteLocation :: String -> Bool -> Repo -> RemoteLocation
|
||||
parseRemoteLocation s knownurl repo = go
|
||||
where
|
||||
s' = calcloc s
|
||||
s' = fromMaybe s $ insteadOfUrl s ".insteadof" $ fullconfig repo
|
||||
go
|
||||
#ifdef mingw32_HOST_OS
|
||||
| dosstyle s' = RemotePath (dospath s')
|
||||
|
@ -98,28 +98,6 @@ parseRemoteLocation s knownurl repo = go
|
|||
| urlstyle s' = RemoteUrl s'
|
||||
| knownurl && s' == s = RemoteUrl s'
|
||||
| otherwise = RemotePath s'
|
||||
-- insteadof config can rewrite remote location
|
||||
calcloc l
|
||||
| null insteadofs = l
|
||||
| otherwise = replacement ++ drop (S.length bestvalue) l
|
||||
where
|
||||
replacement = decodeBS $ S.drop (S.length prefix) $
|
||||
S.take (S.length bestkey - S.length suffix) bestkey
|
||||
(bestkey, bestvalue) =
|
||||
case maximumBy longestvalue insteadofs of
|
||||
(ConfigKey k, ConfigValue v) -> (k, v)
|
||||
(ConfigKey k, NoConfigValue) -> (k, mempty)
|
||||
longestvalue (_, a) (_, b) = compare b a
|
||||
insteadofs = filterconfig $ \case
|
||||
(ConfigKey k, ConfigValue v) ->
|
||||
prefix `S.isPrefixOf` k &&
|
||||
suffix `S.isSuffixOf` k &&
|
||||
v `S.isPrefixOf` encodeBS l
|
||||
(_, NoConfigValue) -> False
|
||||
filterconfig f = filter f $
|
||||
concatMap splitconfigs $ M.toList $ fullconfig repo
|
||||
splitconfigs (k, vs) = map (\v -> (k, v)) (NE.toList vs)
|
||||
(prefix, suffix) = ("url." , ".insteadof")
|
||||
-- git supports URIs that contain unescaped characters such as
|
||||
-- spaces. So to test if it's a (git) URI, escape those.
|
||||
urlstyle v = isURI (escapeURIString isUnescapedInURI v)
|
||||
|
@ -147,3 +125,26 @@ parseRemoteLocation s knownurl repo = go
|
|||
dosstyle = hasDrive
|
||||
dospath = fromRawFilePath . fromInternalGitPath . toRawFilePath
|
||||
#endif
|
||||
|
||||
insteadOfUrl :: String -> S.ByteString -> RepoFullConfig -> Maybe String
|
||||
insteadOfUrl u configsuffix fullcfg
|
||||
| null insteadofs = Nothing
|
||||
| otherwise = Just $ replacement ++ drop (S.length bestvalue) u
|
||||
where
|
||||
replacement = decodeBS $ S.drop (S.length configprefix) $
|
||||
S.take (S.length bestkey - S.length configsuffix) bestkey
|
||||
(bestkey, bestvalue) =
|
||||
case maximumBy longestvalue insteadofs of
|
||||
(ConfigKey k, ConfigValue v) -> (k, v)
|
||||
(ConfigKey k, NoConfigValue) -> (k, mempty)
|
||||
longestvalue (_, a) (_, b) = compare b a
|
||||
insteadofs = filterconfig $ \case
|
||||
(ConfigKey k, ConfigValue v) ->
|
||||
configprefix `S.isPrefixOf` k &&
|
||||
configsuffix `S.isSuffixOf` k &&
|
||||
v `S.isPrefixOf` encodeBS u
|
||||
(_, NoConfigValue) -> False
|
||||
filterconfig f = filter f $
|
||||
concatMap splitconfigs $ M.toList fullcfg
|
||||
splitconfigs (k, vs) = map (\v -> (k, v)) (NE.toList vs)
|
||||
configprefix = "url."
|
||||
|
|
|
@ -41,9 +41,9 @@ data RepoLocation
|
|||
|
||||
data Repo = Repo
|
||||
{ location :: RepoLocation
|
||||
, config :: M.Map ConfigKey ConfigValue
|
||||
, config :: RepoConfig
|
||||
-- a given git config key can actually have multiple values
|
||||
, fullconfig :: M.Map ConfigKey (NE.NonEmpty ConfigValue)
|
||||
, fullconfig :: RepoFullConfig
|
||||
-- remoteName holds the name used for this repo in some other
|
||||
-- repo's list of remotes, when this repo is such a remote
|
||||
, remoteName :: Maybe RemoteName
|
||||
|
@ -60,6 +60,10 @@ data Repo = Repo
|
|||
-- when using this repository.
|
||||
, repoPathSpecifiedExplicitly :: Bool
|
||||
} deriving (Show, Eq, Ord)
|
||||
|
||||
type RepoConfig = M.Map ConfigKey ConfigValue
|
||||
|
||||
type RepoFullConfig = M.Map ConfigKey (NE.NonEmpty ConfigValue)
|
||||
|
||||
newtype ConfigKey = ConfigKey S.ByteString
|
||||
deriving (Ord, Eq)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue