From: Joey Hess Date: Mon, 17 Jun 2024 19:00:11 +0000 (-0400) Subject: started on git-annex-shell cluster support X-Git-Tag: archive/raspbian/10.20250416-2+rpi1~1^2~21^2~315^2~67 X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=291280ced250ebdcb903d6d1f8d30cbd4af202ee;p=git-annex.git started on git-annex-shell cluster support Works down to P2P protocol. The question now is, how to handle protocol version negotiation for clusters? Connecting to each node to find their protocol versions and using the lowest would be too expensive with a lot of nodes. So it seems that the cluster needs to pick its own protocol version to use with the client. Then it can either negotiate that same version with the nodes when it comes time to use them, or it can translate between multiple protocol versions. That seems complicated. Thinking it would be ok to refuse to use a node if it is not able to negotiate the same protocol version with it as with the client. That will mean that sometimes need nodes to be upgraded when upgrading the cluster's proxy. But protocol versions rarely change. --- diff --git a/Annex.hs b/Annex.hs index 1e3825ad19..ca2d83c3a3 100644 --- a/Annex.hs +++ b/Annex.hs @@ -215,7 +215,7 @@ data AnnexState = AnnexState , urloptions :: Maybe UrlOptions , insmudgecleanfilter :: Bool , getvectorclock :: IO CandidateVectorClock - , proxyremote :: Maybe (Types.Remote.RemoteA Annex) + , proxyremote :: Maybe (Either ClusterUUID (Types.Remote.RemoteA Annex)) } newAnnexState :: GitConfig -> Git.Repo -> IO AnnexState diff --git a/CmdLine/GitAnnexShell.hs b/CmdLine/GitAnnexShell.hs index 11652e36b8..8091260aca 100644 --- a/CmdLine/GitAnnexShell.hs +++ b/CmdLine/GitAnnexShell.hs @@ -21,6 +21,7 @@ import Remote.GCrypt (getGCryptUUID) import P2P.Protocol (ServerMode(..)) import Git.Types import Logs.Proxy +import Logs.Cluster import Logs.UUID import Remote @@ -193,21 +194,33 @@ checkProxy remoteuuid ouruuid = M.lookup ouruuid <$> getProxies >>= \case Just proxies -> case filter (\p -> proxyRemoteUUID p == remoteuuid) (S.toList proxies) of [] -> notconfigured - ps -> do - -- This repository may have multiple - -- remotes that access the same repository. - -- Proxy for the lowest cost one that - -- is configured to be used as a proxy. - rs <- concat . byCost <$> remoteList - let sameuuid r = uuid r == remoteuuid - let samename r p = name r == proxyRemoteName p - case headMaybe (filter (\r -> sameuuid r && any (samename r) ps) rs) of - Nothing -> notconfigured - Just r -> do - Annex.changeState $ \st -> - st { Annex.proxyremote = Just r } - return True + 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 + -- be used as a proxy. + proxyfor ps = do + rs <- concat . byCost <$> remoteList + let sameuuid r = uuid r == remoteuuid + let samename r p = name r == proxyRemoteName p + case headMaybe (filter (\r -> sameuuid r && any (samename r) ps) rs) of + Nothing -> notconfigured + Just r -> do + Annex.changeState $ \st -> + st { Annex.proxyremote = Just (Right r) } + return True + + proxyforcluster cu = do + clusters <- getClusters + if M.member cu (clusterUUIDs clusters) + then do + Annex.changeState $ \st -> + st { Annex.proxyremote = Just (Left cu) } + return True + else notconfigured + notconfigured = M.lookup remoteuuid <$> uuidDescMap >>= \case - Just desc -> giveup $ "not configured to proxy for repository " ++ (fromUUIDDesc desc) + Just desc -> giveup $ "not configured to proxy for repository " ++ fromUUIDDesc desc Nothing -> return False diff --git a/Command/P2PStdIO.hs b/Command/P2PStdIO.hs index 5424df8140..a2bc93cbc8 100644 --- a/Command/P2PStdIO.hs +++ b/Command/P2PStdIO.hs @@ -17,6 +17,7 @@ import Annex.UUID import qualified CmdLine.GitAnnexShell.Checks as Checks import Remote.Helper.Ssh (openP2PShellConnection', closeP2PShellConnection) import Logs.Location +import Logs.Cluster import qualified Remote import System.IO.Error @@ -40,8 +41,12 @@ start theiruuid = startingCustomOutput (ActionItemOther Nothing) $ do (False, True) -> P2P.ServeAppendOnly (False, False) -> P2P.ServeReadWrite Annex.getState Annex.proxyremote >>= \case - Nothing -> performLocal theiruuid servermode - Just r -> performProxy theiruuid servermode r + Nothing -> + performLocal theiruuid servermode + Just (Right r) -> + performProxy theiruuid servermode r + Just (Left clusteruuid) -> + performProxyCluster theiruuid clusteruuid servermode performLocal :: UUID -> P2P.ServerMode -> CommandPerform performLocal theiruuid servermode = do @@ -51,48 +56,60 @@ performLocal theiruuid servermode = do P2P.net $ P2P.sendMessage (P2P.AUTH_SUCCESS myuuid) P2P.serveAuthed servermode myuuid runst <- liftIO $ mkRunState $ Serving theiruuid Nothing - runFullProto runst conn server >>= \case - Right () -> done - -- Avoid displaying an error when the client hung up on us. - Left (ProtoFailureIOError e) | isEOFError e -> done - Left e -> giveup (describeProtoFailure e) - where - done = next $ return True + p2pErrHandler (const p2pDone) (runFullProto runst conn server) performProxy :: UUID -> P2P.ServerMode -> Remote -> CommandPerform performProxy clientuuid servermode remote = do - clientrunst <- liftIO (mkRunState $ Serving clientuuid Nothing) - let clientside = ClientSide clientrunst (stdioP2PConnection Nothing) - getClientProtocolVersion remote clientside + clientside <- proxyClientSide clientuuid + getClientProtocolVersion (Remote.uuid remote) clientside (withclientversion clientside) - protoerrhandler + p2pErrHandler where withclientversion clientside (Just (clientmaxversion, othermsg)) = do - remoteside <- connectremote clientmaxversion - proxy done proxymethods servermode clientside remoteside - othermsg protoerrhandler - withclientversion _ Nothing = done + remoteside <- proxySshRemoteSide clientmaxversion remote + proxy p2pDone proxymethods servermode clientside remoteside + othermsg p2pErrHandler + withclientversion _ Nothing = p2pDone proxymethods = ProxyMethods { removedContent = \u k -> logChange k u InfoMissing , addedContent = \u k -> logChange k u InfoPresent } - -- FIXME: Support special remotes. - connectremote clientmaxversion = mkRemoteSide (Remote.uuid remote) $ - openP2PShellConnection' remote clientmaxversion >>= \case - Just conn@(P2P.IO.OpenConnection (remoterunst, remoteconn, _)) -> - return $ Just - ( remoterunst - , remoteconn - , void $ liftIO $ closeP2PShellConnection conn - ) - _ -> return Nothing +performProxyCluster :: UUID -> ClusterUUID -> P2P.ServerMode -> CommandPerform +performProxyCluster clientuuid clusteruuid servermode = do + clientside <- proxyClientSide clientuuid + getClientProtocolVersion (fromClusterUUID clusteruuid) clientside + (withclientversion clientside) + p2pErrHandler + where + withclientversion clientside (Just (clientmaxversion, othermsg)) = do + giveup "TODO" + withclientversion _ Nothing = p2pDone + +proxyClientSide :: UUID -> Annex ClientSide +proxyClientSide clientuuid = do + clientrunst <- liftIO (mkRunState $ Serving clientuuid Nothing) + return $ ClientSide clientrunst (stdioP2PConnection Nothing) - protoerrhandler cont a = a >>= \case - -- Avoid displaying an error when the client hung up on us. - Left (ProtoFailureIOError e) | isEOFError e -> done - Left e -> giveup (describeProtoFailure e) - Right v -> cont v - - done = next $ return True +-- FIXME: Support special remotes. +proxySshRemoteSide :: P2P.ProtocolVersion -> Remote -> Annex RemoteSide +proxySshRemoteSide clientmaxversion remote = mkRemoteSide (Remote.uuid remote) $ + openP2PShellConnection' remote clientmaxversion >>= \case + Just conn@(P2P.IO.OpenConnection (remoterunst, remoteconn, _)) -> + return $ Just + ( remoterunst + , remoteconn + , void $ liftIO $ closeP2PShellConnection conn + ) + _ -> return Nothing + +p2pErrHandler :: (a -> CommandPerform) -> Annex (Either ProtoFailure a) -> CommandPerform +p2pErrHandler cont a = a >>= \case + -- Avoid displaying an error when the client hung up on us. + Left (ProtoFailureIOError e) | isEOFError e -> p2pDone + Left e -> giveup (describeProtoFailure e) + Right v -> cont v + +p2pDone :: CommandPerform +p2pDone = next $ return True diff --git a/Logs/Cluster.hs b/Logs/Cluster.hs index 67bb4a69da..584dcb6867 100644 --- a/Logs/Cluster.hs +++ b/Logs/Cluster.hs @@ -8,14 +8,10 @@ {-# LANGUAGE OverloadedStrings, TupleSections #-} module Logs.Cluster ( - ClusterUUID, - isClusterUUID, - fromClusterUUID, - ClusterNodeUUID(..), + module Types.Cluster, getClusters, loadClusters, recordCluster, - Clusters(..) ) where import qualified Annex diff --git a/P2P/Proxy.hs b/P2P/Proxy.hs index ca96819857..ed668fa781 100644 --- a/P2P/Proxy.hs +++ b/P2P/Proxy.hs @@ -12,7 +12,6 @@ module P2P.Proxy where import Annex.Common import P2P.Protocol import P2P.IO -import qualified Remote import Utility.Metered (nullMeterUpdate) import Control.Concurrent.STM @@ -60,20 +59,20 @@ type ProtoErrorHandled r = - brought up yet. -} getClientProtocolVersion - :: Remote + :: UUID -> ClientSide -> (Maybe (ProtocolVersion, Maybe Message) -> Annex r) -> ProtoErrorHandled r -getClientProtocolVersion remote (ClientSide clientrunst clientconn) cont protoerrhandler = - protoerrhandler cont $ client $ getClientProtocolVersion' remote +getClientProtocolVersion remoteuuid (ClientSide clientrunst clientconn) cont protoerrhandler = + protoerrhandler cont $ client $ getClientProtocolVersion' remoteuuid where client = liftIO . runNetProto clientrunst clientconn getClientProtocolVersion' - :: Remote + :: UUID -> Proto (Maybe (ProtocolVersion, Maybe Message)) -getClientProtocolVersion' remote = do - net $ sendMessage (AUTH_SUCCESS (Remote.uuid remote)) +getClientProtocolVersion' remoteuuid = do + net $ sendMessage (AUTH_SUCCESS remoteuuid) msg <- net receiveMessage case msg of Nothing -> return Nothing