diff --git a/Annex/Proxy.hs b/Annex/Proxy.hs index b69287078f..854ce289e2 100644 --- a/Annex/Proxy.hs +++ b/Annex/Proxy.hs @@ -245,24 +245,23 @@ proxySpecialRemote protoversion r ihdl ohdl owaitv oclosedv = go {- Check if this repository can proxy for a specified remote uuid, - and if so enable proxying for it. -} checkCanProxy :: UUID -> UUID -> Annex Bool -checkCanProxy remoteuuid ouruuid = checkCanProxy' remoteuuid ouruuid >>= \case - Right v -> do - Annex.changeState $ \st -> st { Annex.proxyremote = Just v } - return True - Left Nothing -> return False - Left (Just err) -> giveup err +checkCanProxy remoteuuid ouruuid = do + ourproxies <- M.lookup ouruuid <$> getProxies + checkCanProxy' ourproxies remoteuuid >>= \case + Right v -> do + Annex.changeState $ \st -> st { Annex.proxyremote = Just v } + return True + Left Nothing -> return False + Left (Just err) -> giveup err -checkCanProxy' :: UUID -> UUID -> Annex (Either (Maybe String) (Either ClusterUUID Remote)) -checkCanProxy' remoteuuid ouruuid = M.lookup ouruuid <$> getProxies >>= \case - Nothing -> return (Left Nothing) - -- This repository has (or had) proxying enabled. So it's - -- ok to display error messages that talk about proxies. - Just proxies -> - case filter (\p -> proxyRemoteUUID p == remoteuuid) (S.toList proxies) of - [] -> notconfigured - ps -> case mkClusterUUID remoteuuid of - Just cu -> proxyforcluster cu - Nothing -> proxyfor ps +checkCanProxy' :: Maybe (S.Set Proxy) -> UUID -> Annex (Either (Maybe String) (Either ClusterUUID Remote)) +checkCanProxy' Nothing _ = return (Left Nothing) +checkCanProxy' (Just proxies) remoteuuid = + case filter (\p -> proxyRemoteUUID p == remoteuuid) (S.toList proxies) of + [] -> notconfigured + ps -> case mkClusterUUID remoteuuid of + Just cu -> proxyforcluster cu + Nothing -> proxyfor ps where -- This repository may have multiple remotes that access the same -- repository. Proxy for the lowest cost one that is configured to diff --git a/P2P/Http/State.hs b/P2P/Http/State.hs index 6877cea7d3..36f6d6ce69 100644 --- a/P2P/Http/State.hs +++ b/P2P/Http/State.hs @@ -30,6 +30,7 @@ import Types.Cluster import CmdLine.Action (startConcurrency) import Utility.ThreadScheduler import Utility.HumanTime +import Logs.Proxy import Annex.Proxy import Annex.Cluster import qualified P2P.Proxy as Proxy @@ -188,12 +189,13 @@ withP2PConnections withP2PConnections workerpool proxyconnectionpoolsize clusterconcurrency a = do enableInteractiveBranchAccess myuuid <- getUUID + myproxies <- M.lookup myuuid <$> getProxies reqv <- liftIO newEmptyTMVarIO relv <- liftIO newEmptyTMVarIO endv <- liftIO newEmptyTMVarIO proxypool <- liftIO $ newTMVarIO (0, mempty) asyncservicer <- liftIO $ async $ - servicer myuuid proxypool reqv relv endv + servicer myuuid myproxies proxypool reqv relv endv let endit = do liftIO $ atomically $ putTMVar endv () liftIO $ wait asyncservicer @@ -204,7 +206,7 @@ withP2PConnections workerpool proxyconnectionpoolsize clusterconcurrency a = do atomically $ putTMVar reqv (connparams, respvar) atomically $ takeTMVar respvar - servicer myuuid proxypool reqv relv endv = do + servicer myuuid myproxies proxypool reqv relv endv = do reqrel <- liftIO $ atomically $ (Right <$> takeTMVar reqv) @@ -214,25 +216,25 @@ withP2PConnections workerpool proxyconnectionpoolsize clusterconcurrency a = do (Left . Left <$> takeTMVar endv) case reqrel of Right (connparams, respvar) -> do - servicereq myuuid proxypool relv connparams + servicereq myuuid myproxies proxypool relv connparams >>= atomically . putTMVar respvar - servicer myuuid proxypool reqv relv endv + servicer myuuid myproxies proxypool reqv relv endv Left (Right releaseconn) -> do releaseconn - servicer myuuid proxypool reqv relv endv + servicer myuuid myproxies proxypool reqv relv endv Left (Left ()) -> return () - servicereq myuuid proxypool relv connparams + servicereq myuuid myproxies proxypool relv connparams | connectionServerUUID connparams == myuuid = localConnection relv connparams workerpool | otherwise = atomically (getProxyConnectionPool proxypool connparams) >>= \case Just conn -> proxyConnection proxyconnectionpoolsize relv connparams workerpool proxypool conn - Nothing -> checkcanproxy myuuid proxypool relv connparams + Nothing -> checkcanproxy myproxies proxypool relv connparams - checkcanproxy myuuid proxypool relv connparams = + checkcanproxy myproxies proxypool relv connparams = inAnnexWorker' workerpool - (checkCanProxy' (connectionServerUUID connparams) myuuid) + (checkCanProxy' myproxies (connectionServerUUID connparams)) >>= \case Right (Left reason) -> return $ Left $ ConnectionFailed $ diff --git a/doc/todo/git-annex_proxies.mdwn b/doc/todo/git-annex_proxies.mdwn index 8dbb8e1388..f94c65490a 100644 --- a/doc/todo/git-annex_proxies.mdwn +++ b/doc/todo/git-annex_proxies.mdwn @@ -28,9 +28,6 @@ Planned schedule of work: ## work notes -* getProxies reads the proxy log every time, which is unncessarily slow. - memoize - * An interrupted PUT to cluster that has a node that is a special remote over http leaves open the connection to the cluster, so the next request opens another one.