avoid repeatedly parsing the proxy log

This commit is contained in:
Joey Hess 2024-07-28 16:04:20 -04:00
parent 2fdec6b4e1
commit dfe65b92c8
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 27 additions and 29 deletions

View file

@ -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

View file

@ -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 $

View file

@ -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.