From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 23 Jul 2024 18:31:32 +0000 (-0400)
Subject: Remote.Git checkpresent works with annex+http urls.
X-Git-Tag: archive/raspbian/10.20250416-2+rpi1~1^2~21^2~228^2~73
X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=4e15b786cadddc7fb09166de3343cacdede09200;p=git-annex.git

Remote.Git checkpresent works with annex+http urls.
---

diff --git a/Command/P2PHttp.hs b/Command/P2PHttp.hs
index b322d18115..515cdae4b2 100644
--- a/Command/P2PHttp.hs
+++ b/Command/P2PHttp.hs
@@ -69,12 +69,7 @@ optParser _ = Options
 		)
 
 seek :: Options -> CommandSeek
-seek o = getAnnexWorkerPool $ \workerpool -> do
-	-- XXX remove this
-	when (isNothing (portOption o)) $ do
-		liftIO $ putStrLn "test begins"
-		testLocking
-		giveup "TEST DONE" 
+seek o = getAnnexWorkerPool $ \workerpool ->
 	withLocalP2PConnections workerpool $ \acquireconn -> liftIO $ do
 		authenv <- getAuthEnv
 		st <- mkP2PHttpServerState acquireconn workerpool $
diff --git a/P2P/Http/Url.hs b/P2P/Http/Url.hs
index b80ae33350..e087edd9b3 100644
--- a/P2P/Http/Url.hs
+++ b/P2P/Http/Url.hs
@@ -65,6 +65,15 @@ parseP2PHttpUrl us
 		case UUID.fromString p of
 			Nothing -> Nothing
 			Just _ -> return (UUID (encodeBS p)) 
+	
+	-- The servant server uses urls that start with "/git-annex/",
+	-- and so the servant client adds that to the base url. So remove
+	-- it from the url that the user provided. However, it may not be
+	-- present, eg if some other server is speaking the git-annex
+	-- protocol. The UUID is also removed from the end of the url.
+	basepath u = case drop 1 $ reverse $ P.splitDirectories (uriPath u) of
+		("git-annex":"/":rest) -> P.joinPath (reverse rest)
+		rest -> P.joinPath (reverse rest)
 
 #ifdef WITH_SERVANT
 	mkbaseurl s u = do
@@ -75,7 +84,7 @@ parseP2PHttpUrl us
 		return $ P2PHttpUrl us (extractuuid u) $ BaseUrl
 			{ baseUrlScheme = s
 			, baseUrlHost = uriRegName auth
-			, baseUrlPath = uriPath u
+			, baseUrlPath = basepath u
 			, baseUrlPort = port
 			}
 #endif