avoid padding in servePut

This means that when the client sends a truncated data to indicate
invalidity, DATA is not passed the full expected data. That leaves the
P2P connection in a state where it cannot be reused. While so far, they
are not reused, they will be later when proxies are supported. So, have
to close the P2P connection in this situation.

Command/P2PHttp.hs

@@ -186,7 +186,7 @@ testPut = do
 		(AssociatedFile (Just "foo"))
 		"foocontent"
 		30
-		(liftIO (print "validity check") >> return True)
+		(liftIO (print "validity check") >> return False)
 	liftIO $ print res
 
 testRemove = do

P2P/Http.hs

@@ -544,13 +544,12 @@ servePut st resultmangle su apiver (DataLength len) (B64Key k) cu bypass baf mof
 	validityv <- liftIO newEmptyTMVarIO
 	let validitycheck = local $ runValidityCheck $
 		liftIO $ atomically $ readTMVar validityv
-	content <- liftIO $ S.unSourceT stream (gather validityv)
+	tooshortv <- liftIO newEmptyTMVarIO
+	content <- liftIO $ S.unSourceT stream (gather validityv tooshortv)
 	res <- withP2PConnection' apiver st cu su bypass sec auth WriteAction
 		(\st -> st { connectionWaitVar = False }) $ \conn ->
-			liftIO $ inAnnexWorker st $
+			liftIO (protoaction conn content validitycheck)
-				enteringStage (TransferStage Download) $
+				`finally` checktooshort conn tooshortv
-					runFullProto (clientRunState conn) (clientP2PConnection conn) $
-						protoaction content validitycheck
 	case res of
 		Right (Right (Just plusuuids)) -> return $ resultmangle $
 			PutResultPlus True (map B64UUID plusuuids)
@@ -561,7 +560,12 @@ servePut st resultmangle su apiver (DataLength len) (B64Key k) cu bypass baf mof
 		Left err -> throwError $
 			err500 { errBody = encodeBL (show err) }
   where
-	protoaction content validitycheck = put' k af $ \offset' ->
+	protoaction conn content validitycheck = inAnnexWorker st $
+		enteringStage (TransferStage Download) $
+			runFullProto (clientRunState conn) (clientP2PConnection conn) $
+				protoaction' content validitycheck
+	
+	protoaction' content validitycheck = put' k af $ \offset' ->
 		let offsetdelta = offset' - offset
 		in case compare offset' offset of
 			EQ -> sendContent' nullMeterUpdate (Len len)
@@ -584,36 +588,41 @@ servePut st resultmangle su apiver (DataLength len) (B64Key k) cu bypass baf mof
 		Nothing -> Nothing
 
 	-- Streams the ByteString from the client. Avoids returning a longer
-	-- or shorter than expected ByteString by truncating or padding;
+	-- than expected ByteString by truncating to the expected length. 
-	-- in such cases the data is not Valid.
+	-- Returns a shorter than expected ByteString when the data is not
-	gather validityv = unsafeInterleaveIO . go 0
+	-- valid.
+	gather validityv tooshortv = unsafeInterleaveIO . go 0
 	  where
-		go n S.Stop
+		go n S.Stop = do
-			| n == len = do
+			atomically $ do
-				atomically $ writeTMVar validityv Valid
+				writeTMVar validityv $
-				return LI.Empty
+					if n == len then Valid else Invalid
-			| otherwise = do
+				writeTMVar tooshortv (n /= len)
-				atomically $ writeTMVar validityv Invalid
+			return LI.Empty
-				padout n
 		go n (S.Error _err) = do
-			atomically $ writeTMVar validityv Invalid
+			atomically $ do
-			padout n
+				writeTMVar validityv Invalid
+				writeTMVar tooshortv (n /= len)
+			return LI.Empty
 		go n (S.Skip s) = go n s
 		go n (S.Effect ms) = ms >>= go n
 		go n (S.Yield v s) =
 			let !n' = n + fromIntegral (B.length v)
 			in if n' > len
 				then do
-					atomically $ writeTMVar validityv Invalid
+					atomically $ do
+						writeTMVar validityv Invalid
+						writeTMVar tooshortv True
 					return $ LI.Chunk
 						(B.take (fromIntegral (len - n')) v)
 						LI.Empty
 				else LI.Chunk v <$> unsafeInterleaveIO (go n' s)
-		
+			
-		padout n =return $ LI.Chunk
+	-- The connection can no longer be used when too short a DATA has
-			(B.replicate (fromIntegral (len-n))
+	-- been written to it.
-				(fromIntegral (ord 'X')))
+	checktooshort conn tooshortv =
-			LI.Empty
+		liftIO $ whenM (atomically $ fromMaybe True <$> tryTakeTMVar tooshortv) $
+			closeP2PConnection conn
 
 clientPut
 	:: ClientEnv
@@ -655,7 +664,7 @@ clientPut clientenv (ProtocolVersion ver) k su cu bypass auth moffset af content
 			modifyMVar v $ \case
 				(n, (b:[])) -> do
 					let !n' = n + B.length b
-					ifM (checkvalid n)
+					ifM (checkvalid n')
 						( return ((n', []), b)
 						-- The key's content is invalid, but
 						-- the amount of data is the same as the

P2P/Http/State.hs

@@ -154,6 +154,11 @@ data P2PConnectionPair = P2PConnectionPair
 	, clientP2PConnection :: P2PConnection
 	, serverP2PConnection :: P2PConnection
 	, releaseP2PConnection :: IO ()
+	-- ^ Releases a P2P connection, which can be reused for other
+	-- requests.
+	, closeP2PConnection :: IO ()
+	-- ^ Closes a P2P connection, which is in a state where it is no
+	-- longer usable.
 	}
 
 proxyClientNetProto :: P2PConnectionPair -> P2P.Proto a -> IO (Either P2P.ProtoFailure a)
@@ -229,7 +234,7 @@ mkP2PConnectionPair connparams relv startworker = do
 	serverrunst <- mkserverrunst
 	asyncworker <- async $
 		startworker serverrunst serverconn
-	let releaseconn = atomically $ putTMVar relv $
+	let releaseconn = atomically $ void $ tryPutTMVar relv $
 		liftIO $ wait asyncworker
 			>>= either throwM return
 	return $ Right $ P2PConnectionPair
@@ -237,6 +242,7 @@ mkP2PConnectionPair connparams relv startworker = do
 		, clientP2PConnection = clientconn
 		, serverP2PConnection = serverconn
 		, releaseP2PConnection = releaseconn
+		, closeP2PConnection = releaseconn
 		}
   where
 	mkserverrunst = do

doc/todo/git-annex_proxies.mdwn

@@ -28,10 +28,6 @@ Planned schedule of work:
 
 ## work notes
 
-* servePut and clientPut pad the data to indicate when it's not valid.
-  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