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:
Joey Hess 2024-12-03 14:01:35 -04:00
parent 0404968d10
commit dd052dcba1
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
7 changed files with 79 additions and 41 deletions

View file

@ -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."