diff --git a/Annex/Cluster.hs b/Annex/Cluster.hs index e9299836fe..5e9f53a5d9 100644 --- a/Annex/Cluster.hs +++ b/Annex/Cluster.hs @@ -15,6 +15,7 @@ import Logs.Cluster import P2P.Proxy import P2P.Protocol import P2P.IO +import Annex.Proxy import Logs.Location import Types.Command import Remote.List @@ -46,22 +47,31 @@ proxyCluster clusteruuid proxydone servermode clientside protoerrhandler = do -- determine. Instead, pick the newest protocol version -- that we and the client both speak. let protocolversion = min maxProtocolVersion clientmaxversion - selectnode <- clusterProxySelector clusteruuid + selectnode <- clusterProxySelector clusteruuid protocolversion proxy proxydone proxymethods servermode clientside selectnode protocolversion othermsg protoerrhandler withclientversion Nothing = proxydone -clusterProxySelector :: ClusterUUID -> Annex ProxySelector -clusterProxySelector clusteruuid = do +clusterProxySelector :: ClusterUUID -> ProtocolVersion -> Annex ProxySelector +clusterProxySelector clusteruuid protocolversion = do nodes <- (fromMaybe S.empty . M.lookup clusteruuid . clusterUUIDs) <$> getClusters remotes <- filter (flip S.member nodes . ClusterNodeUUID . Remote.uuid) <$> remoteList + remotesides <- mapM (proxySshRemoteSide protocolversion) remotes return $ ProxySelector { proxyCHECKPRESENT = \k -> error "TODO" - , proxyLOCKCONTENT = \k -> error "TODO" - , proxyUNLOCKCONTENT = error "TODO" - , proxyREMOVE = \k -> error "TODO" - , proxyGET = \k -> error "TODO" + , proxyGET = \k -> do + locs <- S.fromList <$> loggedLocations k + case filter (flip S.member locs . remoteUUID) remotesides of + -- TODO: Avoid always using same remote + (r:_) -> return (Just r) + [] -> return Nothing , proxyPUT = \k -> error "TODO" + , proxyREMOVE = \k -> error "TODO" + -- Content is not locked on the cluster as a whole, + -- instead it can be locked on individual nodes that are + -- proxied to the client. + , proxyLOCKCONTENT = const (pure Nothing) + , proxyUNLOCKCONTENT = pure Nothing } diff --git a/P2P/Proxy.hs b/P2P/Proxy.hs index a255a1af81..89a7199f5f 100644 --- a/P2P/Proxy.hs +++ b/P2P/Proxy.hs @@ -55,20 +55,20 @@ closeRemoteSide remoteside = - -} data ProxySelector = ProxySelector { proxyCHECKPRESENT :: Key -> Annex RemoteSide - , proxyLOCKCONTENT :: Key -> Annex RemoteSide - , proxyUNLOCKCONTENT :: Annex RemoteSide + , proxyLOCKCONTENT :: Key -> Annex (Maybe RemoteSide) + , proxyUNLOCKCONTENT :: Annex (Maybe RemoteSide) , proxyREMOVE :: Key -> Annex RemoteSide - , proxyGET :: Key -> Annex RemoteSide + , proxyGET :: Key -> Annex (Maybe RemoteSide) , proxyPUT :: Key -> Annex RemoteSide } singleProxySelector :: RemoteSide -> ProxySelector singleProxySelector r = ProxySelector { proxyCHECKPRESENT = const (pure r) - , proxyLOCKCONTENT = const (pure r) - , proxyUNLOCKCONTENT = pure r + , proxyLOCKCONTENT = const (pure (Just r)) + , proxyUNLOCKCONTENT = pure (Just r) , proxyREMOVE = const (pure r) - , proxyGET = const (pure r) + , proxyGET = const (pure (Just r)) , proxyPUT = const (pure r) } @@ -163,19 +163,28 @@ proxy proxydone proxymethods servermode (ClientSide clientrunst clientconn) prox CHECKPRESENT k -> do remoteside <- proxyCHECKPRESENT proxyselector k proxyresponse remoteside message (const proxynextclientmessage) - LOCKCONTENT k -> do - remoteside <- proxyLOCKCONTENT proxyselector k - proxyresponse remoteside message (const proxynextclientmessage) - UNLOCKCONTENT -> do - remoteside <- proxyUNLOCKCONTENT proxyselector - proxynoresponse remoteside message proxynextclientmessage + LOCKCONTENT k -> proxyLOCKCONTENT proxyselector k >>= \case + Just remoteside -> + proxyresponse remoteside message + (const proxynextclientmessage) + Nothing -> + protoerrhandler proxynextclientmessage $ + client $ net $ sendMessage FAILURE + UNLOCKCONTENT -> proxyUNLOCKCONTENT proxyselector >>= \case + Just remoteside -> + proxynoresponse remoteside message + proxynextclientmessage + Nothing -> proxynextclientmessage () REMOVE k -> do remoteside <- proxyREMOVE proxyselector k servermodechecker checkREMOVEServerMode $ handleREMOVE remoteside k message - GET _ _ k -> do - remoteside <- proxyGET proxyselector k - handleGET remoteside message + GET _ _ k -> proxyGET proxyselector k >>= \case + Just remoteside -> handleGET remoteside message + Nothing -> + protoerrhandler proxynextclientmessage $ + client $ net $ sendMessage $ + ERROR "content not present" PUT _ k -> do remoteside <- proxyPUT proxyselector k servermodechecker checkPUTServerMode $ diff --git a/doc/todo/git-annex_proxies.mdwn b/doc/todo/git-annex_proxies.mdwn index e35836248e..e88f2fa2e0 100644 --- a/doc/todo/git-annex_proxies.mdwn +++ b/doc/todo/git-annex_proxies.mdwn @@ -57,6 +57,11 @@ For June's work on [[design/passthrough_proxy]], implementation plan: * Getting a key from a cluster should proxy from one of the nodes that has it, or from the proxy repository itself if it has the key. +* Getting a key from a cluster currently always selects the lowest cost + remote, and always the same remote if cost is the same. Should + round-robin amoung remotes, and prefer to avoid using remotes that + other git-annex processes are currently using. + * Implement upload with fanout and reporting back additional UUIDs over P2P protocol.