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.

Git/Remote.hs

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

Git/Types.hs

@@ -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)