Remote.Git checkpresent works with annex+http urls.
This commit is contained in:
parent
b0eed55d4f
commit
4e15b786ca
2 changed files with 11 additions and 7 deletions
|
@ -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 $
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue