From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 23 Jul 2024 13:12:21 +0000 (-0400)
Subject: starting support for remote.name.annexUrl set to annex+http
X-Git-Tag: archive/raspbian/10.20250416-2+rpi1~1^2~21^2~228^2~78
X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=5c39652235bb8d0a9527811191fc597443ba1baa;p=git-annex.git

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

diff --git a/Command/P2PHttp.hs b/Command/P2PHttp.hs
index 1753df37e8..d642cac286 100644
--- a/Command/P2PHttp.hs
+++ b/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
diff --git a/P2P/Http.hs b/P2P/Http.hs
index d1efce3ed4..a1f5684371 100644
--- a/P2P/Http.hs
+++ b/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
diff --git a/P2P/Http/Url.hs b/P2P/Http/Url.hs
new file mode 100644
index 0000000000..8d52874ee3
--- /dev/null
+++ b/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
diff --git a/Remote/Git.hs b/Remote/Git.hs
index d225788397..593a930b98 100644
--- a/Remote/Git.hs
+++ b/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
diff --git a/git-annex.cabal b/git-annex.cabal
index aefbc41b6a..06116a38a7 100644
--- a/git-annex.cabal
+++ b/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