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 1753df37e88222e4cc5555140ca2562852b0c181..d642cac286370108eb0834da46d6ffd065b3f3d3 100644 (file)
--- 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 d1efce3ed49311f2972f61dd0807daa13e8e41b3..a1f568437120ca6abee86d58467534718f257984 100644 (file)
--- 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 (file)
index 0000000..8d52874
--- /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 d22578839746667d72953fef0a8e48b3289d95da..593a930b9802f6144e324a0cb7fd2ba4df86d274 100644 (file)
--- 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 aefbc41b6a28f68671c09e7bbd6826b3d1936048..06116a38a7e4c94f7bc00ff9c02f2bcc7a102298 100644 (file)
--- 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