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.

diff --git a/Command/P2PHttp.hs b/Command/P2PHttp.hs
index ec37bf6d0a3ed88476185a54515371a8b145e3cd..51f992cb915976b53838fb82db9b00c457842fe1 100644 (file)
--- a/Command/P2PHttp.hs
+++ b/Command/P2PHttp.hs
@@ -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

diff --git a/P2P/Http/State.hs b/P2P/Http/State.hs
index 24d430957efeeea8568a2c4560b993962b882e21..a9df86122044cc95ee64c57122986b56da9983e9 100644 (file)
--- a/P2P/Http/State.hs
+++ b/P2P/Http/State.hs
@@ -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