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:
Joey Hess 2024-06-23 09:28:18 -04:00
parent a6a04b7e5e
commit 5b332a87be
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
14 changed files with 144 additions and 59 deletions

View file

@ -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)