initial, working support for getting from clusters

Currently tends to put all the load on a single node, which will need to
be improved.

diff --git a/Annex/Cluster.hs b/Annex/Cluster.hs
index e9299836fe459cd9ad9e62fd0f8427664aa1efbb..5e9f53a5d995cc76c226072e67bedaaa8f90806b 100644 (file)
--- 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 a255a1af814714b98730ab16d1012ac33e108b64..89a7199f5f60564f4d66a8bf1e00ab45f5c63721 100644 (file)
--- 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 e35836248e219ba1e127ae773e3939bd526ac1c7..e88f2fa2e0d34e0435a2e4f1c4f0473a40cd26af 100644 (file)
--- 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.