add proxied uuids to http server state map
This fixes support for proxying after last commit broke it. Note that withP2PConnections is called at server startup, and so only proxies seen at that point will appear in the map and be used. It was already the case that a proxy added after p2phttp was running would not be served. I think that is possibly a bug, but at least this commit doesn't introduce the problem, though it might make it harder to fix it. As bugs go, it's probably not a big deal, because after all, git configs needs to be set in the local repository, followed by git-annex updateproxy being run, to set up proxying. If someone is doing that, they can restart their http server I suppose.
This commit is contained in:
parent
254073569f
commit
07026cf58b
2 changed files with 10 additions and 12 deletions
|
@ -16,7 +16,6 @@ import P2P.Http.Server
|
|||
import P2P.Http.Url
|
||||
import qualified P2P.Protocol as P2P
|
||||
import Utility.Env
|
||||
import Annex.UUID
|
||||
|
||||
import Servant
|
||||
import qualified Network.Wai.Handler.Warp as Warp
|
||||
|
@ -103,19 +102,17 @@ optParser _ = Options
|
|||
))
|
||||
|
||||
seek :: Options -> CommandSeek
|
||||
seek o = do
|
||||
u <- getUUID
|
||||
getAnnexWorkerPool $ \workerpool ->
|
||||
withP2PConnections workerpool
|
||||
(fromMaybe 1 $ proxyConnectionsOption o)
|
||||
(fromMaybe 1 $ clusterJobsOption o)
|
||||
(go u workerpool)
|
||||
seek o = getAnnexWorkerPool $ \workerpool ->
|
||||
withP2PConnections workerpool
|
||||
(fromMaybe 1 $ proxyConnectionsOption o)
|
||||
(fromMaybe 1 $ clusterJobsOption o)
|
||||
(go workerpool)
|
||||
where
|
||||
go u workerpool acquireconn = liftIO $ do
|
||||
go workerpool servinguuids acquireconn = liftIO $ do
|
||||
authenv <- getAuthEnv
|
||||
st <- mkP2PHttpServerState acquireconn workerpool $
|
||||
mkGetServerMode authenv o
|
||||
let mst = M.singleton u st
|
||||
let mst = M.fromList $ zip servinguuids (repeat st)
|
||||
let settings = Warp.setPort port $ Warp.setHost host $
|
||||
Warp.defaultSettings
|
||||
case (certFileOption o, privateKeyFileOption o) of
|
||||
|
|
|
@ -213,7 +213,7 @@ withP2PConnections
|
|||
:: AnnexWorkerPool
|
||||
-> ProxyConnectionPoolSize
|
||||
-> ClusterConcurrency
|
||||
-> (AcquireP2PConnection -> Annex a)
|
||||
-> ([UUID] -> AcquireP2PConnection -> Annex a)
|
||||
-> Annex a
|
||||
withP2PConnections workerpool proxyconnectionpoolsize clusterconcurrency a = do
|
||||
enableInteractiveBranchAccess
|
||||
|
@ -228,7 +228,8 @@ withP2PConnections workerpool proxyconnectionpoolsize clusterconcurrency a = do
|
|||
let endit = do
|
||||
liftIO $ atomically $ putTMVar endv ()
|
||||
liftIO $ wait asyncservicer
|
||||
a (acquireconn reqv) `finally` endit
|
||||
let servinguuids = myuuid : map proxyRemoteUUID (maybe [] S.toList myproxies)
|
||||
a servinguuids (acquireconn reqv) `finally` endit
|
||||
where
|
||||
acquireconn reqv connparams = do
|
||||
respvar <- newEmptyTMVarIO
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue