mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

use a record to reduce the huge number of parameters

Browse source
This commit is contained in:
Joey Hess 2024-07-25 15:18:06 -04:00
parent 7b56fe1350
commit 6ef6ad808f
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 86 additions and 75 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
Annex/Cluster.hs
View file

@ -68,10 +68,18 @@ proxyCluster clusteruuid proxydone servermode clientside protoerrhandler = do
protocolversion bypassuuids protocolversion bypassuuids
concurrencyconfig <- getConcurrencyConfig concurrencyconfig <- getConcurrencyConfig
proxystate <- liftIO mkProxyState proxystate <- liftIO mkProxyState
proxy proxydone proxymethods proxystate servermode clientside let proxyparams = ProxyParams
(fromClusterUUID clusteruuid) { proxyMethods = proxymethods
selectnode concurrencyconfig protocolversion , proxyState = proxystate
othermsg (protoerrhandler closenodes) , proxyServerMode = servermode
, proxyClientSide = clientside
, proxyUUID = fromClusterUUID clusteruuid
, proxySelector = selectnode
, proxyConcurrencyConfig = concurrencyconfig
, proxyProtocolVersion = protocolversion
}
proxy proxydone proxyparams othermsg
(protoerrhandler closenodes)
clusterProxySelector :: ClusterUUID -> ProtocolVersion -> Bypass -> Annex (ProxySelector, Annex ()) clusterProxySelector :: ClusterUUID -> ProtocolVersion -> Bypass -> Annex (ProxySelector, Annex ())
clusterProxySelector clusteruuid protocolversion (Bypass bypass) = do clusterProxySelector clusteruuid protocolversion (Bypass bypass) = do

27
Command/P2PStdIO.hs
View file

@ -61,7 +61,7 @@ performLocal theiruuid servermode = do
performProxy :: UUID -> P2P.ServerMode -> Remote -> CommandPerform performProxy :: UUID -> P2P.ServerMode -> Remote -> CommandPerform
performProxy clientuuid servermode r = do performProxy clientuuid servermode r = do
clientside <- proxyClientSide clientuuid clientside <- mkProxyClientSide clientuuid
getClientProtocolVersion (Remote.uuid r) clientside getClientProtocolVersion (Remote.uuid r) clientside
(withclientversion clientside) (withclientversion clientside)
(p2pErrHandler noop) (p2pErrHandler noop)
@ -77,13 +77,18 @@ performProxy clientuuid servermode r = do
p2pDone p2pDone
let errhandler = p2pErrHandler (closeRemoteSide remoteside) let errhandler = p2pErrHandler (closeRemoteSide remoteside)
proxystate <- liftIO mkProxyState proxystate <- liftIO mkProxyState
let runproxy othermsg' = proxy closer let proxyparams = ProxyParams
proxymethods proxystate { proxyMethods = proxymethods
servermode clientside , proxyState = proxystate
(Remote.uuid r) , proxyServerMode = servermode
(singleProxySelector remoteside) , proxyClientSide = clientside
concurrencyconfig , proxyUUID = Remote.uuid r
protocolversion othermsg' errhandler , proxySelector = singleProxySelector remoteside
, proxyConcurrencyConfig = concurrencyconfig
, proxyProtocolVersion = protocolversion
}
let runproxy othermsg' = proxy closer proxyparams
othermsg' errhandler
sendClientProtocolVersion clientside othermsg protocolversion sendClientProtocolVersion clientside othermsg protocolversion
runproxy errhandler runproxy errhandler
withclientversion _ Nothing = p2pDone withclientversion _ Nothing = p2pDone
@ -95,11 +100,11 @@ performProxy clientuuid servermode r = do
performProxyCluster :: UUID -> ClusterUUID -> P2P.ServerMode -> CommandPerform performProxyCluster :: UUID -> ClusterUUID -> P2P.ServerMode -> CommandPerform
performProxyCluster clientuuid clusteruuid servermode = do performProxyCluster clientuuid clusteruuid servermode = do
clientside <- proxyClientSide clientuuid clientside <- mkProxyClientSide clientuuid
proxyCluster clusteruuid p2pDone servermode clientside p2pErrHandler proxyCluster clusteruuid p2pDone servermode clientside p2pErrHandler
proxyClientSide :: UUID -> Annex ClientSide mkProxyClientSide :: UUID -> Annex ClientSide
proxyClientSide clientuuid = do mkProxyClientSide clientuuid = do
clientrunst <- liftIO (mkRunState $ Serving clientuuid Nothing) clientrunst <- liftIO (mkRunState $ Serving clientuuid Nothing)
ClientSide clientrunst <$> liftIO (stdioP2PConnectionDupped Nothing) ClientSide clientrunst <$> liftIO (stdioP2PConnectionDupped Nothing)

118
P2P/Proxy.hs
View file

@ -200,91 +200,87 @@ mkProxyState = ProxyState
<$> newTVarIO mempty <$> newTVarIO mempty
<*> newTVarIO Nothing <*> newTVarIO Nothing
data ProxyParams = ProxyParams
{ proxyMethods :: ProxyMethods
, proxyState :: ProxyState
, proxyServerMode :: ServerMode
, proxyClientSide :: ClientSide
, proxyUUID :: UUID
, proxySelector :: ProxySelector
, proxyConcurrencyConfig :: ConcurrencyConfig
, proxyProtocolVersion :: ProtocolVersion
-- ^ Protocol version being spoken between the proxy and the
-- client. When there are multiple remotes, some may speak an
-- earlier version.
}
{- Proxy between the client and the remote. This picks up after {- Proxy between the client and the remote. This picks up after
- sendClientProtocolVersion. - sendClientProtocolVersion.
-} -}
proxy proxy
:: Annex r :: Annex r
-> ProxyMethods -> ProxyParams
-> ProxyState
-> ServerMode
-> ClientSide
-> UUID
-> ProxySelector
-> ConcurrencyConfig
-> ProtocolVersion
-- ^ Protocol version being spoken between the proxy and the
-- client. When there are multiple remotes, some may speak an
-- earlier version.
-> Maybe Message -> Maybe Message
-- ^ non-VERSION message that was received from the client when -- ^ non-VERSION message that was received from the client when
-- negotiating protocol version, and has not been responded to yet -- negotiating protocol version, and has not been responded to yet
-> ProtoErrorHandled r -> ProtoErrorHandled r
proxy proxydone proxymethods proxystate servermode (ClientSide clientrunst clientconn) remoteuuid proxyselector concurrencyconfig protocolversion othermsg protoerrhandler = do proxy proxydone proxyparams othermsg protoerrhandler = do
case othermsg of case othermsg of
Nothing -> proxynextclientmessage () Nothing -> proxynextclientmessage ()
Just message -> proxyclientmessage (Just message) Just message -> proxyclientmessage (Just message)
where where
client = liftIO . runNetProto clientrunst clientconn
proxyclientmessage Nothing = proxydone proxyclientmessage Nothing = proxydone
proxyclientmessage (Just message) = proxyRequest proxyclientmessage (Just message) = proxyRequest
proxydone proxymethods proxystate servermode proxydone proxyparams proxynextclientmessage
(ClientSide clientrunst clientconn) remoteuuid message protoerrhandler
proxyselector concurrencyconfig protocolversion
proxynextclientmessage message
protoerrhandler
proxynextclientmessage () = protoerrhandler proxyclientmessage $ proxynextclientmessage () = protoerrhandler proxyclientmessage $
client (net receiveMessage) client (net receiveMessage)
client = liftIO . runNetProto clientrunst clientconn
ClientSide clientrunst clientconn = proxyClientSide proxyparams
{- Handles proxying a single request between the client and remote. -} {- Handles proxying a single request between the client and remote. -}
proxyRequest proxyRequest
:: Annex r :: Annex r
-> ProxyMethods -> ProxyParams
-> ProxyState
-> ServerMode
-> ClientSide
-> UUID
-> ProxySelector
-> ConcurrencyConfig
-> ProtocolVersion
-> (() -> Annex r) -- ^ called once the request has been handled -> (() -> Annex r) -- ^ called once the request has been handled
-> Message -> Message
-> ProtoErrorHandled r -> ProtoErrorHandled r
proxyRequest proxydone proxymethods proxystate servermode (ClientSide clientrunst clientconn) remoteuuid proxyselector concurrencyconfig (ProtocolVersion protocolversion) requestcomplete requestmessage protoerrhandler = proxyRequest proxydone proxyparams requestcomplete requestmessage protoerrhandler =
case requestmessage of case requestmessage of
CHECKPRESENT k -> proxyCHECKPRESENT proxyselector k >>= \case CHECKPRESENT k -> proxyCHECKPRESENT (proxySelector proxyparams) k >>= \case
Just remoteside -> Just remoteside ->
proxyresponse remoteside requestmessage proxyresponse remoteside requestmessage
(const requestcomplete) (const requestcomplete)
Nothing -> Nothing ->
protoerrhandler requestcomplete $ protoerrhandler requestcomplete $
client $ net $ sendMessage FAILURE client $ net $ sendMessage FAILURE
LOCKCONTENT k -> proxyLOCKCONTENT proxyselector k >>= \case LOCKCONTENT k -> proxyLOCKCONTENT (proxySelector proxyparams) k >>= \case
Just remoteside -> Just remoteside ->
proxyresponse remoteside requestmessage proxyresponse remoteside requestmessage
(const requestcomplete) (const requestcomplete)
Nothing -> Nothing ->
protoerrhandler requestcomplete $ protoerrhandler requestcomplete $
client $ net $ sendMessage FAILURE client $ net $ sendMessage FAILURE
UNLOCKCONTENT -> proxyUNLOCKCONTENT proxyselector >>= \case UNLOCKCONTENT -> proxyUNLOCKCONTENT (proxySelector proxyparams) >>= \case
Just remoteside -> Just remoteside ->
proxynoresponse remoteside requestmessage proxynoresponse remoteside requestmessage
requestcomplete requestcomplete
Nothing -> requestcomplete () Nothing -> requestcomplete ()
REMOVE k -> do REMOVE k -> do
remotesides <- proxyREMOVE proxyselector k remotesides <- proxyREMOVE (proxySelector proxyparams) k
servermodechecker checkREMOVEServerMode $ servermodechecker checkREMOVEServerMode $
handleREMOVE remotesides k requestmessage handleREMOVE remotesides k requestmessage
REMOVE_BEFORE _ k -> do REMOVE_BEFORE _ k -> do
remotesides <- proxyREMOVE proxyselector k remotesides <- proxyREMOVE (proxySelector proxyparams) k
servermodechecker checkREMOVEServerMode $ servermodechecker checkREMOVEServerMode $
handleREMOVE remotesides k requestmessage handleREMOVE remotesides k requestmessage
GETTIMESTAMP -> do GETTIMESTAMP -> do
remotesides <- proxyGETTIMESTAMP proxyselector remotesides <- proxyGETTIMESTAMP (proxySelector proxyparams)
handleGETTIMESTAMP remotesides handleGETTIMESTAMP remotesides
GET _ _ k -> proxyGET proxyselector k >>= \case GET _ _ k -> proxyGET (proxySelector proxyparams) k >>= \case
Just remoteside -> handleGET remoteside requestmessage Just remoteside -> handleGET remoteside requestmessage
Nothing -> Nothing ->
protoerrhandler requestcomplete $ protoerrhandler requestcomplete $
@ -292,7 +288,7 @@ proxyRequest proxydone proxymethods proxystate servermode (ClientSide clientruns
ERROR "content not present" ERROR "content not present"
PUT paf k -> do PUT paf k -> do
af <- getassociatedfile paf af <- getassociatedfile paf
remotesides <- proxyPUT proxyselector af k remotesides <- proxyPUT (proxySelector proxyparams) af k
servermodechecker checkPUTServerMode $ servermodechecker checkPUTServerMode $
handlePUT remotesides k requestmessage handlePUT remotesides k requestmessage
BYPASS _ -> requestcomplete () BYPASS _ -> requestcomplete ()
@ -331,7 +327,9 @@ proxyRequest proxydone proxymethods proxystate servermode (ClientSide clientruns
where where
client = liftIO . runNetProto clientrunst clientconn client = liftIO . runNetProto clientrunst clientconn
servermodechecker c a = c servermode $ \case ClientSide clientrunst clientconn = proxyClientSide proxyparams
servermodechecker c a = c (proxyServerMode proxyparams) $ \case
Nothing -> a Nothing -> a
Just notallowed -> Just notallowed ->
protoerrhandler requestcomplete $ protoerrhandler requestcomplete $
@ -377,9 +375,9 @@ proxyRequest proxydone proxymethods proxystate servermode (ClientSide clientruns
-- to avoid needing timestamp translation. -- to avoid needing timestamp translation.
handleGETTIMESTAMP (remoteside:[]) = do handleGETTIMESTAMP (remoteside:[]) = do
liftIO $ atomically $ do liftIO $ atomically $ do
writeTVar (proxyRemoteLatestTimestamps proxystate) writeTVar (proxyRemoteLatestTimestamps (proxyState proxyparams))
mempty mempty
writeTVar (proxyRemoteLatestLocalTimestamp proxystate) writeTVar (proxyRemoteLatestLocalTimestamp (proxyState proxyparams))
Nothing Nothing
proxyresponse remoteside GETTIMESTAMP proxyresponse remoteside GETTIMESTAMP
(const requestcomplete) (const requestcomplete)
@ -394,14 +392,14 @@ proxyRequest proxydone proxymethods proxystate servermode (ClientSide clientruns
remotetimes <- (M.fromList . mapMaybe join) <$> getremotetimes remotetimes <- (M.fromList . mapMaybe join) <$> getremotetimes
localtime <- liftIO currentMonotonicTimestamp localtime <- liftIO currentMonotonicTimestamp
liftIO $ atomically $ do liftIO $ atomically $ do
writeTVar (proxyRemoteLatestTimestamps proxystate) writeTVar (proxyRemoteLatestTimestamps (proxyState proxyparams))
remotetimes remotetimes
writeTVar (proxyRemoteLatestLocalTimestamp proxystate) writeTVar (proxyRemoteLatestLocalTimestamp (proxyState proxyparams))
(Just localtime) (Just localtime)
protoerrhandler requestcomplete $ protoerrhandler requestcomplete $
client $ net $ sendMessage (TIMESTAMP localtime) client $ net $ sendMessage (TIMESTAMP localtime)
where where
getremotetimes = forMC concurrencyconfig remotesides $ \r -> getremotetimes = forMC (proxyConcurrencyConfig proxyparams) remotesides $ \r ->
runRemoteSideOrSkipFailed r $ do runRemoteSideOrSkipFailed r $ do
net $ sendMessage GETTIMESTAMP net $ sendMessage GETTIMESTAMP
net receiveMessage >>= return . \case net receiveMessage >>= return . \case
@ -422,10 +420,10 @@ proxyRequest proxydone proxymethods proxystate servermode (ClientSide clientruns
client $ net $ sendMessage FAILURE client $ net $ sendMessage FAILURE
handleREMOVE remotesides k message = do handleREMOVE remotesides k message = do
tsm <- liftIO $ readTVarIO $ tsm <- liftIO $ readTVarIO $
proxyRemoteLatestTimestamps proxystate proxyRemoteLatestTimestamps (proxyState proxyparams)
oldlocaltime <- liftIO $ readTVarIO $ oldlocaltime <- liftIO $ readTVarIO $
proxyRemoteLatestLocalTimestamp proxystate proxyRemoteLatestLocalTimestamp (proxyState proxyparams)
v <- forMC concurrencyconfig remotesides $ \r -> v <- forMC (proxyConcurrencyConfig proxyparams) remotesides $ \r ->
runRemoteSideOrSkipFailed r $ do runRemoteSideOrSkipFailed r $ do
case message of case message of
REMOVE_BEFORE ts _ -> do REMOVE_BEFORE ts _ -> do
@ -450,11 +448,11 @@ proxyRequest proxydone proxymethods proxystate servermode (ClientSide clientruns
_ -> Nothing _ -> Nothing
let v' = map join v let v' = map join v
let us = concatMap snd $ catMaybes v' let us = concatMap snd $ catMaybes v'
mapM_ (\u -> removedContent proxymethods u k) us mapM_ (\u -> removedContent (proxyMethods proxyparams) u k) us
protoerrhandler requestcomplete $ protoerrhandler requestcomplete $
client $ net $ sendMessage $ client $ net $ sendMessage $
let nonplussed = all (== remoteuuid) us let nonplussed = all (== proxyUUID proxyparams) us
|| protocolversion < 2 || proxyProtocolVersion proxyparams < ProtocolVersion 2
in if all (maybe False (fst . fst)) v' in if all (maybe False (fst . fst)) v'
then if nonplussed then if nonplussed
then SUCCESS then SUCCESS
@ -472,7 +470,7 @@ proxyRequest proxydone proxymethods proxystate servermode (ClientSide clientruns
_ -> protoerr _ -> protoerr
handlePUT (remoteside:[]) k message handlePUT (remoteside:[]) k message
| Remote.uuid (remote remoteside) == remoteuuid = | Remote.uuid (remote remoteside) == proxyUUID proxyparams =
getresponse (runRemoteSide remoteside) message $ \resp -> case resp of getresponse (runRemoteSide remoteside) message $ \resp -> case resp of
ALREADY_HAVE -> protoerrhandler requestcomplete $ ALREADY_HAVE -> protoerrhandler requestcomplete $
client $ net $ sendMessage resp client $ net $ sendMessage resp
@ -509,12 +507,12 @@ proxyRequest proxydone proxymethods proxystate servermode (ClientSide clientruns
requestcomplete () requestcomplete ()
relayPUTRecord k remoteside SUCCESS = do relayPUTRecord k remoteside SUCCESS = do
addedContent proxymethods (Remote.uuid (remote remoteside)) k addedContent (proxyMethods proxyparams) (Remote.uuid (remote remoteside)) k
return $ Just [Remote.uuid (remote remoteside)] return $ Just [Remote.uuid (remote remoteside)]
relayPUTRecord k remoteside (SUCCESS_PLUS us) = do relayPUTRecord k remoteside (SUCCESS_PLUS us) = do
let us' = (Remote.uuid (remote remoteside)) : us let us' = (Remote.uuid (remote remoteside)) : us
forM_ us' $ \u -> forM_ us' $ \u ->
addedContent proxymethods u k addedContent (proxyMethods proxyparams) u k
return $ Just us' return $ Just us'
relayPUTRecord _ _ _ = relayPUTRecord _ _ _ =
return Nothing return Nothing
@ -536,14 +534,14 @@ proxyRequest proxydone proxymethods proxystate servermode (ClientSide clientruns
let alreadyhave = \case let alreadyhave = \case
Right (Left _) -> True Right (Left _) -> True
_ -> False _ -> False
l <- forMC concurrencyconfig remotesides initiate l <- forMC (proxyConcurrencyConfig proxyparams) remotesides initiate
if all alreadyhave l if all alreadyhave l
then if protocolversion < 2 then if proxyProtocolVersion proxyparams < ProtocolVersion 2
then protoerrhandler requestcomplete $ then protoerrhandler requestcomplete $
client $ net $ sendMessage ALREADY_HAVE client $ net $ sendMessage ALREADY_HAVE
else protoerrhandler requestcomplete $ else protoerrhandler requestcomplete $
client $ net $ sendMessage $ ALREADY_HAVE_PLUS $ client $ net $ sendMessage $ ALREADY_HAVE_PLUS $
filter (/= remoteuuid) $ filter (/= proxyUUID proxyparams) $
map (Remote.uuid . remote) (lefts (rights l)) map (Remote.uuid . remote) (lefts (rights l))
else if null (rights l) else if null (rights l)
-- no response from any remote -- no response from any remote
@ -559,7 +557,7 @@ proxyRequest proxydone proxymethods proxystate servermode (ClientSide clientruns
let totallen = datalen + minoffset let totallen = datalen + minoffset
-- Tell each remote how much data to expect, depending -- Tell each remote how much data to expect, depending
-- on the remote's offset. -- on the remote's offset.
rs <- forMC concurrencyconfig remotes $ \r@(remoteside, remoteoffset) -> rs <- forMC (proxyConcurrencyConfig proxyparams) remotes $ \r@(remoteside, remoteoffset) ->
runRemoteSideOrSkipFailed remoteside $ do runRemoteSideOrSkipFailed remoteside $ do
net $ sendMessage $ DATA $ Len $ net $ sendMessage $ DATA $ Len $
totallen - remoteoffset totallen - remoteoffset
@ -576,7 +574,7 @@ proxyRequest proxydone proxymethods proxystate servermode (ClientSide clientruns
let (chunk, b') = L.splitAt chunksize b let (chunk, b') = L.splitAt chunksize b
let chunklen = fromIntegral (L.length chunk) let chunklen = fromIntegral (L.length chunk)
let !n' = n + chunklen let !n' = n + chunklen
rs' <- forMC concurrencyconfig rs $ \r@(remoteside, remoteoffset) -> rs' <- forMC (proxyConcurrencyConfig proxyparams) rs $ \r@(remoteside, remoteoffset) ->
if n >= remoteoffset if n >= remoteoffset
then runRemoteSideOrSkipFailed remoteside $ do then runRemoteSideOrSkipFailed remoteside $ do
net $ sendBytes (Len chunklen) chunk nullMeterUpdate net $ sendBytes (Len chunklen) chunk nullMeterUpdate
@ -617,13 +615,13 @@ proxyRequest proxydone proxymethods proxystate servermode (ClientSide clientruns
y $ net $ sendBytes len b nullMeterUpdate y $ net $ sendBytes len b nullMeterUpdate
relayDATAFinish x y sendsuccessfailure () relayDATAFinish x y sendsuccessfailure ()
| protocolversion == 0 = sendsuccessfailure | proxyProtocolVersion proxyparams == ProtocolVersion 0 = sendsuccessfailure
-- Protocol version 1 has a VALID or -- Protocol version 1 has a VALID or
-- INVALID message after the data. -- INVALID message after the data.
| otherwise = relayonemessage x y (\_ () -> sendsuccessfailure) | otherwise = relayonemessage x y (\_ () -> sendsuccessfailure)
relayDATAFinishMulti k rs relayDATAFinishMulti k rs
| protocolversion == 0 = | proxyProtocolVersion proxyparams == ProtocolVersion 0 =
finish $ net receiveMessage finish $ net receiveMessage
| otherwise = | otherwise =
flip protoerrhandler (client $ net $ receiveMessage) $ flip protoerrhandler (client $ net $ receiveMessage) $
@ -638,7 +636,7 @@ proxyRequest proxydone proxymethods proxystate servermode (ClientSide clientruns
net receiveMessage net receiveMessage
where where
finish a = do finish a = do
storeduuids <- forMC concurrencyconfig rs $ \r -> storeduuids <- forMC (proxyConcurrencyConfig proxyparams) rs $ \r ->
runRemoteSideOrSkipFailed r a >>= \case runRemoteSideOrSkipFailed r a >>= \case
Just (Just resp) -> Just (Just resp) ->
relayPUTRecord k r resp relayPUTRecord k r resp
@ -648,7 +646,7 @@ proxyRequest proxydone proxymethods proxystate servermode (ClientSide clientruns
case concat (catMaybes storeduuids) of case concat (catMaybes storeduuids) of
[] -> FAILURE [] -> FAILURE
us us
| protocolversion < 2 -> SUCCESS | proxyProtocolVersion proxyparams < ProtocolVersion 2 -> SUCCESS
| otherwise -> SUCCESS_PLUS us | otherwise -> SUCCESS_PLUS us
-- The associated file received from the P2P protocol -- The associated file received from the P2P protocol