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