dropping from clusters
Dropping from a cluster drops from every node of the cluster. Including nodes that the cluster does not think have the content. This is different from GET and CHECKPRESENT, which do trust the cluster's location log. The difference is that removing from a cluster should make 100% the content is gone from every node. So doing extra work is ok. Compare with CHECKPRESENT where checking every node could make it very expensive, and the worst that can happen in a false negative is extra work being done. Extended the P2P protocol with FAILURE-PLUS to handle the case where a drop from one node succeeds, but a drop from another node fails. In that case the entire cluster drop has failed. Note that SUCCESS-PLUS is returned when dropping from a proxied remote that is not a cluster, when the protocol version supports it. This is because P2P.Proxy does not know when it's proxying for a single node cluster vs for a remote that is not a cluster.
This commit is contained in:
parent
a6a04b7e5e
commit
5b332a87be
14 changed files with 144 additions and 59 deletions
53
P2P/Proxy.hs
53
P2P/Proxy.hs
|
@ -60,11 +60,11 @@ data ProxySelector = ProxySelector
|
|||
{ proxyCHECKPRESENT :: Key -> Annex (Maybe RemoteSide)
|
||||
, proxyLOCKCONTENT :: Key -> Annex (Maybe RemoteSide)
|
||||
, proxyUNLOCKCONTENT :: Annex (Maybe RemoteSide)
|
||||
, proxyREMOVE :: Key -> Annex RemoteSide
|
||||
, proxyREMOVE :: Key -> Annex [RemoteSide]
|
||||
-- ^ remove from all of these remotes
|
||||
, proxyGET :: Key -> Annex (Maybe RemoteSide)
|
||||
-- ^ can get from any of these remotes
|
||||
, proxyPUT :: Key -> Annex [RemoteSide]
|
||||
-- ^ can put to some/all of these remotes
|
||||
-- ^ put to some/all of these remotes
|
||||
}
|
||||
|
||||
singleProxySelector :: RemoteSide -> ProxySelector
|
||||
|
@ -72,7 +72,7 @@ singleProxySelector r = ProxySelector
|
|||
{ proxyCHECKPRESENT = const (pure (Just r))
|
||||
, proxyLOCKCONTENT = const (pure (Just r))
|
||||
, proxyUNLOCKCONTENT = pure (Just r)
|
||||
, proxyREMOVE = const (pure r)
|
||||
, proxyREMOVE = const (pure [r])
|
||||
, proxyGET = const (pure (Just r))
|
||||
, proxyPUT = const (pure [r])
|
||||
}
|
||||
|
@ -187,9 +187,9 @@ proxy proxydone proxymethods servermode (ClientSide clientrunst clientconn) remo
|
|||
proxynextclientmessage
|
||||
Nothing -> proxynextclientmessage ()
|
||||
REMOVE k -> do
|
||||
remoteside <- proxyREMOVE proxyselector k
|
||||
remotesides <- proxyREMOVE proxyselector k
|
||||
servermodechecker checkREMOVEServerMode $
|
||||
handleREMOVE remoteside k message
|
||||
handleREMOVE remotesides k message
|
||||
GET _ _ k -> proxyGET proxyselector k >>= \case
|
||||
Just remoteside -> handleGET remoteside message
|
||||
Nothing ->
|
||||
|
@ -215,6 +215,7 @@ proxy proxydone proxymethods servermode (ClientSide clientrunst clientconn) remo
|
|||
SUCCESS -> protoerr
|
||||
SUCCESS_PLUS _ -> protoerr
|
||||
FAILURE -> protoerr
|
||||
FAILURE_PLUS _ -> protoerr
|
||||
DATA _ -> protoerr
|
||||
VALIDITY _ -> protoerr
|
||||
-- If the client errors out, give up.
|
||||
|
@ -266,14 +267,38 @@ proxy proxydone proxymethods servermode (ClientSide clientrunst clientconn) remo
|
|||
protoerr = do
|
||||
_ <- client $ net $ sendMessage (ERROR "protocol error")
|
||||
giveup "protocol error"
|
||||
|
||||
handleREMOVE remoteside k message =
|
||||
proxyresponse remoteside message $ \resp () -> do
|
||||
case resp of
|
||||
SUCCESS -> removedContent proxymethods
|
||||
(remoteUUID remoteside) k
|
||||
_ -> return ()
|
||||
proxynextclientmessage ()
|
||||
|
||||
handleREMOVE [] _ _ =
|
||||
-- When no places are provided to remove from,
|
||||
-- don't report a successful remote.
|
||||
protoerrhandler proxynextclientmessage $
|
||||
client $ net $ sendMessage FAILURE
|
||||
handleREMOVE remotesides k message = do
|
||||
v <- forM remotesides $ \r ->
|
||||
runRemoteSideOrSkipFailed r $ do
|
||||
net $ sendMessage message
|
||||
net receiveMessage >>= return . \case
|
||||
Just SUCCESS ->
|
||||
Just (True, [remoteUUID r])
|
||||
Just (SUCCESS_PLUS us) ->
|
||||
Just (True, remoteUUID r:us)
|
||||
Just FAILURE ->
|
||||
Just (False, [])
|
||||
Just (FAILURE_PLUS us) ->
|
||||
Just (False, us)
|
||||
_ -> Nothing
|
||||
let v' = map join v
|
||||
let us = concatMap snd $ catMaybes v'
|
||||
mapM_ (\u -> removedContent proxymethods u k) us
|
||||
protoerrhandler proxynextclientmessage $
|
||||
client $ net $ sendMessage $
|
||||
if all (maybe False fst) v'
|
||||
then if null us || protocolversion < 2
|
||||
then SUCCESS
|
||||
else SUCCESS_PLUS us
|
||||
else if null us || protocolversion < 2
|
||||
then FAILURE
|
||||
else FAILURE_PLUS us
|
||||
|
||||
handleGET remoteside message = getresponse (runRemoteSide remoteside) message $
|
||||
withDATA (relayGET remoteside)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue