From a6ea057f6be427026f67d4082455c22f51985b5b Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 28 Jun 2024 13:42:25 -0400
Subject: [PATCH] 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.
---
 Annex/Proxy.hs       |  5 ++++-
 P2P/Protocol.hs      | 16 ++++++++++------
 Remote/Helper/P2P.hs | 12 +++++++++---
 3 files changed, 23 insertions(+), 10 deletions(-)

diff --git a/Annex/Proxy.hs b/Annex/Proxy.hs
index 9fd1e8bc42..3a2c5a938c 100644
--- 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 a77cf76536..57a0b6eb41 100644
--- 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 7e312ed78f..05707fdb03 100644
--- 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
-- 
2.39.5