From efa0efdc445cc44bd27ddf73dd46de008cc1c0b5 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Mon, 22 Jul 2024 11:47:24 -0400
Subject: [PATCH] avoid padding in clientPut

Instead truncate when necessary to indicate invalid content was sent.
Very similar to how serveGet handles it.
---
 P2P/Http.hs                     | 51 +++++++++++++++++++--------------
 doc/todo/git-annex_proxies.mdwn |  2 ++
 2 files changed, 31 insertions(+), 22 deletions(-)

diff --git a/P2P/Http.hs b/P2P/Http.hs
index d120afba49..5ad1ac631c 100644
--- a/P2P/Http.hs
+++ b/P2P/Http.hs
@@ -646,37 +646,44 @@ clientPut clientenv (ProtocolVersion ver) k su cu bypass auth moffset af content
 			return res
   where
 	stream checkv checkresultv = S.SourceT $ \a -> do
+		-- TODO seek to offset when requested
 		bl <- L.readFile contentfile
-		v <- newMVar (0, L.toChunks bl)
+		v <- newMVar (0, filter (not . B.null) (L.toChunks bl))
 		a (go v)
 	  where
-		go v = S.fromActionStep B.null $ do
-			res <- modifyMVar v $ pure . \case
-				(n, []) -> ((n, []), (n, Nothing))
-				(n, (b:bs)) -> 
+		go v = S.fromActionStep B.null $
+			modifyMVar v $ \case
+				(n, (b:[])) -> do
 					let !n' = n + B.length b
-					in ((n', bs), (n, Just b))
-			case res of
-				(_, Just b) -> return b
-				(n, Nothing) -> do
-					void $ liftIO $ atomically $ 
-						tryPutTMVar checkv ()
-					valid <- liftIO $ atomically $
-						readTMVar checkresultv
-					if not valid
-						then if n == fromIntegral contentfilesize
-							then do
-								modifyMVar_ v $ \(_n, l) ->
-									pure (n+1, l)
-								return "X"
-							else return B.empty
-						else return B.empty
+					ifM (checkvalid n)
+						( return ((n', []), b)
+						-- The key's content is invalid, but
+						-- the amount of data is the same as the
+						-- DataLengthHeader indicates. Truncate
+						-- the stream by one byte to indicate
+						-- to the server that it's not valid.
+						, return ((n' - 1, []), B.take (B.length b - 1) b)
+						)
+				(n, []) -> do
+					void $ checkvalid n
+					return ((n, []), mempty)
+				(n, (b:bs)) ->
+					let !n' = n + B.length b
+					in return ((n', bs), b)
+
+		checkvalid n = do
+			void $ liftIO $ atomically $ tryPutTMVar checkv ()
+			valid <- liftIO $ atomically $ readTMVar checkresultv
+			if not valid
+				then return (n /= fromIntegral nlen)
+				else return True
 
 	baf = case af of
 		AssociatedFile Nothing -> Nothing
 		AssociatedFile (Just f) -> Just (B64FilePath f)
 
-	len = DataLength $ case moffset of
+	len = DataLength nlen
+	nlen = case moffset of
 		Nothing -> contentfilesize
 		Just (Offset o) -> contentfilesize - fromIntegral o
 
diff --git a/doc/todo/git-annex_proxies.mdwn b/doc/todo/git-annex_proxies.mdwn
index eb8fdf3431..d21ad3061d 100644
--- a/doc/todo/git-annex_proxies.mdwn
+++ b/doc/todo/git-annex_proxies.mdwn
@@ -32,6 +32,8 @@ Planned schedule of work:
   That should not be necessary, they should always be able to truncate the
   data. 
 
+* clientPut needs to seek to the requested offset in the file.
+
 * Implement: servePutOffset, serveLockContent
 
 * A Locker should expire the lock on its own after 10 minutes initially.
-- 
2.30.2