clean shut down of cluster connection when PUT is interrupted

An interrupted `git-annex copy --to` a cluster via the http server,
when repeated, failed. The http server output "transfer already in
progress, or unable to take transfer lock". Apparently a second
connection was opened to the cluster, because the first connection
never got shut down.

Turned out the problem was that when proxying to a cluster, it would read a
short ByteString from the client, and send that to the nodes. But that left the
nodes warning more. Meanwhile, the proxy was expecting a SUCCESS/FAILURE
message from the nodes. So it didn't return, and so the cluster connection
stayed open.

P2P/Proxy.hs

@@ -558,7 +558,6 @@ proxyRequest proxydone proxyparams requestcomplete requestmessage protoerrhandle
 							(const protoerr)
 	
 	relayPUTMulti minoffset remotes k (Len datalen) _ = do
-		let totallen = datalen + minoffset
 		-- Tell each remote how much data to expect, depending
 		-- on the remote's offset.
 		rs <- forMC (proxyConcurrencyConfig proxyparams) remotes $ \r@(remoteside, remoteoffset) ->
@@ -569,6 +568,8 @@ proxyRequest proxydone proxyparams requestcomplete requestmessage protoerrhandle
 		protoerrhandler (send (catMaybes rs) minoffset) $
 			client $ net $ receiveBytes (Len datalen) nullMeterUpdate
 	  where
+		totallen = datalen + minoffset
+		
 		chunksize = fromIntegral defaultChunkSize
 		
 	  	-- Stream the lazy bytestring out to the remotes in chunks.
@@ -593,7 +594,15 @@ proxyRequest proxydone proxyparams requestcomplete requestmessage protoerrhandle
 								return r
 						else return (Just r)
 			if L.null b'
-				then sent (catMaybes rs')
+				then do
+					-- If we didn't receive as much
+					-- data as expected, close
+					-- connections to all the remotes,
+					-- because they are still waiting
+					-- on the rest of the data.
+					when (n' /= totallen) $
+						mapM_ (closeRemoteSide . fst) rs
+					sent (catMaybes rs')
 				else send (catMaybes rs') n' b'
 
 		sent [] = proxydone

doc/todo/git-annex_proxies.mdwn

@@ -28,12 +28,6 @@ Planned schedule of work:
 
 ## work notes
 
-* An interrupted `git-annex copy --to` a cluster via the http server,
-  when repeated, fails. The http server outputs "transfer already in
-  progress, or unable to take transfer lock". Apparently a second
-  connection gets opened to the cluster, because the first connection
-  never got shut down.
-
 * When part of a file has been sent to a cluster via the http server,
   the transfer interrupted, and another node is added to the cluster,
   and the transfer of the file performed again, there is a failure