starting support for remote.name.annexUrl set to annex+http

In this case, Remote.Git should not use that url for all access to
the repository. It will only be used for annex operations, which isn't
done yet.

Command/P2PHttp.hs

@@ -13,6 +13,7 @@ module Command.P2PHttp where
 
 import Command
 import P2P.Http
+import P2P.Http.Url
 import qualified P2P.Protocol as P2P
 import Annex.Url
 import Utility.Env
@@ -79,7 +80,9 @@ seek o = getAnnexWorkerPool $ \workerpool -> do
 			mkGetServerMode authenv o
 		Warp.run (fromIntegral port) (p2pHttpApp st)
   where
-	port = fromMaybe (fromIntegral defaultHttpProtocolPort) (portOption o)
+	port = fromMaybe
+		(fromIntegral defaultP2PHttpProtocolPort)
+		(portOption o)
 
 mkGetServerMode :: M.Map Auth P2P.ServerMode -> Options -> GetServerMode
 mkGetServerMode _ o _ Nothing

P2P/Http.hs

@@ -43,9 +43,6 @@ import Control.Concurrent.Async
 import Control.Concurrent
 import System.IO.Unsafe
 
-defaultHttpProtocolPort :: Int
-defaultHttpProtocolPort = 9417 -- Git protocol is 9418
-
 type P2PHttpAPI
 	=    "git-annex" :> SU :> PV3 :> "key" :> GetAPI
 	:<|> "git-annex" :> SU :> PV2 :> "key" :> GetAPI

P2P/Http/Url.hs

@@ -0,0 +1,18 @@
+{- P2P protocol over HTTP, urls
+ -
+ - Copyright 2024 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+module P2P.Http.Url where
+
+import Data.List
+
+defaultP2PHttpProtocolPort :: Int
+defaultP2PHttpProtocolPort = 9417 -- Git protocol is 9418
+
+isP2PHttpProtocolUrl :: String -> Bool
+isP2PHttpProtocolUrl s = 
+	"annex+http://" `isPrefixOf` s ||
+	"annex+https://" `isPrefixOf` s

Remote/Git.hs

@@ -58,6 +58,7 @@ import qualified Remote.GitLFS
 import qualified Remote.P2P
 import qualified Remote.Helper.P2P as P2PHelper
 import P2P.Address
+import P2P.Http.Url
 import Annex.Path
 import Creds
 import Types.NumCopies
@@ -107,10 +108,12 @@ list autoinit = do
 	tweakurl c r = do
 		let n = fromJust $ Git.remoteName r
 		case M.lookup (annexurl r) c of
-			Nothing -> return r
-			Just url -> inRepo $ \g ->
-				Git.Construct.remoteNamed n $
-					Git.Construct.fromRemoteLocation (Git.fromConfigValue url) False g
+			Just url | not (isP2PHttpProtocolUrl (Git.fromConfigValue url)) -> 
+				inRepo $ \g -> Git.Construct.remoteNamed n $
+					Git.Construct.fromRemoteLocation
+						(Git.fromConfigValue url)
+						False g
+			_ -> return r
 
 isGitRemoteAnnex :: Git.Repo -> Bool
 isGitRemoteAnnex r = "annex::" `isPrefixOf` Git.repoLocation r

git-annex.cabal

@@ -895,6 +895,7 @@ Executable git-annex
     P2P.Address
     P2P.Annex
     P2P.Auth
+    P2P.Http.Url
     P2P.IO
     P2P.Protocol
     P2P.Proxy