fix handling of ERROR in response to CHECKPRESENT

That error is now rethrown on the client, so it will be displayed.

For example:

$ git-annex fsck x --fast --from AMS-dir
fsck x (special remote reports: directory /home/joey/tmp/bench2/dir is not accessible) failed

No protocol version check is needed. Because in order to talk to a
proxied special remote, the client has to be running the upcoming
git-annex release. Which has this fix in it.

diff --git a/Annex/Proxy.hs b/Annex/Proxy.hs
index 9fd1e8bc424c6213d7798b5dcd60363923d8faec..3a2c5a938ca3047925898983e499ffc4f42ce279 100644 (file)
--- a/Annex/Proxy.hs
+++ b/Annex/Proxy.hs
@@ -81,7 +81,7 @@ proxySpecialRemote protoversion r ihdl ohdl endv = go
                        tryNonAsync (Remote.checkPresent r k) >>= \case
                                Right True -> sendmessage SUCCESS
                                Right False -> sendmessage FAILURE
-                               Left err -> sendmessage (ERROR (show err))
+                               Left err -> propagateerror err
                        go
                Just (LOCKCONTENT _) -> do
                        -- Special remotes do not support locking content.
@@ -119,3 +119,6 @@ proxySpecialRemote protoversion r ihdl ohdl endv = go
 
        sendmessage m = liftIO $ atomically $ putTMVar ihdl (Right m)
        sendbytestring b = liftIO $ atomically $ putTMVar ihdl (Left b)
+
+       propagateerror err = sendmessage $ ERROR $
+               "proxied special remote reports: " ++ show err

diff --git a/P2P/Protocol.hs b/P2P/Protocol.hs
index a77cf7653643e691c76313faeb772a7083d0779e..57a0b6eb414e4df2b5d56068ac77c62a304fc37e 100644 (file)
--- a/P2P/Protocol.hs
+++ b/P2P/Protocol.hs
@@ -353,10 +353,10 @@ sendBypass bypass@(Bypass s)
                        then net $ sendMessage (BYPASS bypass)
                        else return ()
 
-checkPresent :: Key -> Proto Bool
+checkPresent :: Key -> Proto (Either String Bool)
 checkPresent key = do
        net $ sendMessage (CHECKPRESENT key)
-       checkSuccess
+       checkSuccess'
 
 {- Locks content to prevent it from being dropped, while running an action.
  -
@@ -628,14 +628,18 @@ receiveContent mm p sizer storer mkmsg = do
                        return observeFailure
 
 checkSuccess :: Proto Bool
-checkSuccess = do
+checkSuccess = either (const False) id <$> checkSuccess'
+
+checkSuccess' :: Proto (Either String Bool)
+checkSuccess' = do
        ack <- net receiveMessage
        case ack of
-               Just SUCCESS -> return True
-               Just FAILURE -> return False
+               Just SUCCESS -> return (Right True)
+               Just FAILURE -> return (Right False)
+               Just (ERROR err) -> return (Left err)
                _ -> do
                        net $ sendMessage (ERROR "expected SUCCESS or FAILURE")
-                       return False
+                       return (Right False)
 
 checkSuccessPlus :: Proto (Maybe [UUID])
 checkSuccessPlus =

diff --git a/Remote/Helper/P2P.hs b/Remote/Helper/P2P.hs
index 7e312ed78f31ad5bc94b867acdc87f3da6406bba..05707fdb0306829bbc2b1335faece224fbf13396 100644 (file)
--- a/Remote/Helper/P2P.hs
+++ b/Remote/Helper/P2P.hs
@@ -1,6 +1,6 @@
 {- Helpers for remotes using the git-annex P2P protocol.
  -
- - Copyright 2016-2021 Joey Hess <id@joeyh.name>
+ - Copyright 2016-2024 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -20,6 +20,7 @@ import Utility.Tuple
 import Types.NumCopies
 import Annex.Verify
 import Logs.Location
+import Utility.SafeOutput
 
 import Control.Concurrent
 
@@ -74,8 +75,13 @@ remove remoteuuid runner k = runner (P2P.remove k) >>= \case
                        when (u /= remoteuuid) $
                                logChange k u InfoMissing
 
-checkpresent :: ProtoRunner Bool -> Key -> Annex Bool
-checkpresent runner k = maybe remoteUnavail return =<< runner (P2P.checkPresent k)
+checkpresent :: ProtoRunner (Either String Bool) -> Key -> Annex Bool
+checkpresent runner k =
+       runner (P2P.checkPresent k)
+               >>= \case
+                       Nothing -> remoteUnavail
+                       Just (Right b) -> return b
+                       Just (Left err) -> giveup (safeOutput err)
 
 lock :: WithConn a c -> ProtoConnRunner c -> UUID -> Key -> (VerifiedCopy -> Annex a) -> Annex a
 lock withconn connrunner u k callback = withconn $ \conn -> do