Remote.Git checkpresent works with annex+http urls.

diff --git a/Command/P2PHttp.hs b/Command/P2PHttp.hs
index b322d18115d4b085086434732b5fbb99d02a31b5..515cdae4b23ee08437a7785f9005ba99c19b812b 100644 (file)
--- 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 b80ae33350a633971a36ade1760daea8bc7c2a84..e087edd9b38fd166ec233d353baef7e61a11e3ef 100644 (file)
--- 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