Remote.Git checkpresent works with annex+http urls.

This commit is contained in:
Joey Hess 2024-07-23 14:31:32 -04:00
parent b0eed55d4f
commit 4e15b786ca
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 11 additions and 7 deletions

View file

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

View file

@ -66,6 +66,15 @@ parseP2PHttpUrl us
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
auth <- uriAuthority u
@ -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