From 158d7bc933d173775c46b6df52af70d1eafece98 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 28 Jun 2024 14:07:23 -0400 Subject: [PATCH] fix handling of ERROR in response to REMOVE This allows an error message from a proxied special remote to be displayed to the client. In the case where removal from several nodes of a cluster fails, there can be several errors. What to do? I decided to only show the first error to the user. Probably in this case the user is not in a position to do anything about an error message, so best keep it simple. If the problem with the first node is fixed, they'll see the error from the next node. --- Annex/Proxy.hs | 4 ++-- P2P/Protocol.hs | 24 +++++++++++++----------- P2P/Proxy.hs | 16 ++++++++++------ Remote/Git.hs | 2 +- Remote/Helper/P2P.hs | 8 +++++--- 5 files changed, 31 insertions(+), 23 deletions(-) diff --git a/Annex/Proxy.hs b/Annex/Proxy.hs index 3a2c5a938c..21e950dd8b 100644 --- a/Annex/Proxy.hs +++ b/Annex/Proxy.hs @@ -76,7 +76,6 @@ proxySpecialRemote proxySpecialRemote protoversion r ihdl ohdl endv = go where go = receivemessage >>= \case - Just (BYPASS _) -> go Just (CHECKPRESENT k) -> do tryNonAsync (Remote.checkPresent r k) >>= \case Right True -> sendmessage SUCCESS @@ -90,10 +89,11 @@ proxySpecialRemote protoversion r ihdl ohdl endv = go Just (REMOVE k) -> do tryNonAsync (Remote.removeKey r k) >>= \case Right () -> sendmessage SUCCESS - Left _ -> sendmessage FAILURE + Left err -> propagateerror err go Just (PUT af k) -> giveup "TODO PUT" -- XXX Just (GET offset af k) -> giveup "TODO GET" -- XXX + Just (BYPASS _) -> go Just (CONNECT _) -> -- Not supported and the protocol ends here. sendmessage $ CONNECTDONE (ExitFailure 1) diff --git a/P2P/Protocol.hs b/P2P/Protocol.hs index 57a0b6eb41..c65e5c0cd7 100644 --- a/P2P/Protocol.hs +++ b/P2P/Protocol.hs @@ -378,7 +378,7 @@ lockContentWhile runproto key a = bracket setup cleanup a cleanup True = runproto () $ net $ sendMessage UNLOCKCONTENT cleanup False = return () -remove :: Key -> Proto (Bool, Maybe [UUID]) +remove :: Key -> Proto (Either String Bool, Maybe [UUID]) remove key = do net $ sendMessage (REMOVE key) checkSuccessFailurePlus @@ -644,28 +644,30 @@ checkSuccess' = do checkSuccessPlus :: Proto (Maybe [UUID]) checkSuccessPlus = checkSuccessFailurePlus >>= return . \case - (True, v) -> v - (False, _) -> Nothing + (Right True, v) -> v + (Right False, _) -> Nothing + (Left _, _) -> Nothing -checkSuccessFailurePlus :: Proto (Bool, Maybe [UUID]) +checkSuccessFailurePlus :: Proto (Either String Bool, Maybe [UUID]) checkSuccessFailurePlus = do ver <- net getProtocolVersion if ver >= ProtocolVersion 2 then do ack <- net receiveMessage case ack of - Just SUCCESS -> return (True, Just []) - Just (SUCCESS_PLUS l) -> return (True, Just l) - Just FAILURE -> return (False, Nothing) - Just (FAILURE_PLUS l) -> return (False, Just l) + Just SUCCESS -> return (Right True, Just []) + Just (SUCCESS_PLUS l) -> return (Right True, Just l) + Just FAILURE -> return (Right False, Nothing) + Just (FAILURE_PLUS l) -> return (Right False, Just l) + Just (ERROR err) -> return (Left err, Nothing) _ -> do net $ sendMessage (ERROR "expected SUCCESS or SUCCESS-PLUS or FAILURE or FAILURE-PLUS") - return (False, Nothing) + return (Right False, Nothing) else do ok <- checkSuccess if ok - then return (True, Just []) - else return (False, Nothing) + then return (Right True, Just []) + else return (Right False, Nothing) sendSuccess :: Bool -> Proto () sendSuccess True = net $ sendMessage SUCCESS diff --git a/P2P/Proxy.hs b/P2P/Proxy.hs index b18fde4328..45085f4734 100644 --- a/P2P/Proxy.hs +++ b/P2P/Proxy.hs @@ -329,13 +329,15 @@ proxy proxydone proxymethods servermode (ClientSide clientrunst clientconn) remo net $ sendMessage message net receiveMessage >>= return . \case Just SUCCESS -> - Just (True, [Remote.uuid (remote r)]) + Just ((True, Nothing), [Remote.uuid (remote r)]) Just (SUCCESS_PLUS us) -> - Just (True, Remote.uuid (remote r):us) + Just ((True, Nothing), Remote.uuid (remote r):us) Just FAILURE -> - Just (False, []) + Just ((False, Nothing), []) Just (FAILURE_PLUS us) -> - Just (False, us) + Just ((False, Nothing), us) + Just (ERROR err) -> + Just ((False, Just err), []) _ -> Nothing let v' = map join v let us = concatMap snd $ catMaybes v' @@ -344,12 +346,14 @@ proxy proxydone proxymethods servermode (ClientSide clientrunst clientconn) remo client $ net $ sendMessage $ let nonplussed = all (== remoteuuid) us || protocolversion < 2 - in if all (maybe False fst) v' + in if all (maybe False (fst . fst)) v' then if nonplussed then SUCCESS else SUCCESS_PLUS us else if nonplussed - then FAILURE + then case mapMaybe (snd . fst) (catMaybes v') of + [] -> FAILURE + (err:_) -> ERROR err else FAILURE_PLUS us handleGET remoteside message = getresponse (runRemoteSide remoteside) message $ diff --git a/Remote/Git.hs b/Remote/Git.hs index 844beb3b2e..9cc83c4397 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -456,7 +456,7 @@ dropKey' repo r st@(State connpool duc _ _ _) key ) | Git.repoIsHttp repo = giveup "dropping from http remote not supported" | otherwise = P2PHelper.remove (uuid r) - (Ssh.runProto r connpool (return (False, Nothing))) key + (Ssh.runProto r connpool (return (Right False, Nothing))) key lockKey :: Remote -> State -> Key -> (VerifiedCopy -> Annex r) -> Annex r lockKey r st key callback = do diff --git a/Remote/Helper/P2P.hs b/Remote/Helper/P2P.hs index 05707fdb03..80c0f9f6a9 100644 --- a/Remote/Helper/P2P.hs +++ b/Remote/Helper/P2P.hs @@ -60,12 +60,14 @@ retrieve gc runner k af dest p verifyconfig = do Just (False, _) -> giveup "Transfer failed" Nothing -> remoteUnavail -remove :: UUID -> ProtoRunner (Bool, Maybe [UUID]) -> Key -> Annex () +remove :: UUID -> ProtoRunner (Either String Bool, Maybe [UUID]) -> Key -> Annex () remove remoteuuid runner k = runner (P2P.remove k) >>= \case - Just (True, alsoremoveduuids) -> note alsoremoveduuids - Just (False, alsoremoveduuids) -> do + Just (Right True, alsoremoveduuids) -> note alsoremoveduuids + Just (Right False, alsoremoveduuids) -> do note alsoremoveduuids giveup "removing content from remote failed" + Just (Left err, _) -> do + giveup (safeOutput err) Nothing -> remoteUnavail where -- The remote reports removal from other UUIDs than its own, -- 2.39.5