proxy updates location tracking information

This does mean a redundant write to the git-annex branch. But,
it means that two clients can be using the same proxy, and after
one sends a file to a proxied remote, the other only has to pull from
the proxy to learn about that. It does not need to pull from every
remote behind the proxy (which it couldn't do anyway as git repo
access is not currently proxied).

Anyway, the overhead of this in git-annex branch writes is no worse
than eg, sending a file to a repository where git-annex assistant
is running, which then sends the file on to a remote, and updates
the git-annex branch then. Indeed, when the assistant also drops
the local copy, that results in more writes to the git-annex branch.

Command/P2PStdIO.hs

@@ -16,6 +16,8 @@ import qualified Annex
 import Annex.UUID
 import qualified CmdLine.GitAnnexShell.Checks as Checks
 import Remote.Helper.Ssh (openP2PShellConnection', closeP2PShellConnection)
+import Logs.Location
+import qualified Remote
 
 import System.IO.Error
 
@@ -68,15 +70,20 @@ performProxy clientuuid servermode remote = do
   where
 	withclientversion clientside (Just (clientmaxversion, othermsg)) =
 		connectremote clientmaxversion $ \remoteside ->
-			proxy done servermode clientside remoteside 
+			proxy done proxymethods servermode clientside remoteside 
 				othermsg protoerrhandler
 	withclientversion _ Nothing = done
 	
+	proxymethods = ProxyMethods
+		{ removedContent = \u k -> logChange k u InfoMissing
+		, addedContent = \u k -> logChange k u InfoPresent
+		}
+
 	-- FIXME: Support special remotes.
 	connectremote clientmaxversion cont = 
 		openP2PShellConnection' remote clientmaxversion >>= \case
 			Just conn@(P2P.IO.OpenConnection (remoterunst, remoteconn, _)) ->
-				cont (RemoteSide remoterunst remoteconn)
+				cont (RemoteSide remoterunst remoteconn (Remote.uuid remote))
 					`finally` liftIO (closeP2PShellConnection conn)
 			_  -> giveup "Unable to connect to remote."
 

P2P/Proxy.hs

@@ -16,7 +16,17 @@ import qualified Remote
 import Utility.Metered (nullMeterUpdate)
 
 data ClientSide = ClientSide RunState P2PConnection
-data RemoteSide = RemoteSide RunState P2PConnection
+data RemoteSide = RemoteSide RunState P2PConnection UUID
+
+{- To keep this module limited to P2P protocol actions,
+ - all other actions that a proxy needs to do are provided
+ - here. -}
+data ProxyMethods = ProxyMethods
+	{ removedContent :: UUID -> Key -> Annex ()
+	-- ^ called when content is removed from a repository
+	, addedContent :: UUID -> Key -> Annex ()
+	-- ^ called when content is added to a repository
+	}
 
 {- Type of function that takes a error handler, which is
  - used to handle a ProtoFailure when receiving a message
@@ -69,6 +79,7 @@ getClientProtocolVersion' remote = do
  -}
 proxy 
 	:: Annex r
+	-> ProxyMethods
 	-> ServerMode
 	-> ClientSide
 	-> RemoteSide
@@ -76,7 +87,7 @@ proxy
 	-- ^ non-VERSION message that was received from the client when
 	-- negotiating protocol version, and has not been responded to yet
 	-> ProtoErrorHandled Annex r
-proxy proxydone servermode clientside remoteside othermessage protoerrhandler = do
+proxy proxydone proxymethods servermode clientside remoteside othermessage protoerrhandler = do
 	case othermessage of
 		Just message -> proxyclientmessage (Just message)
 		Nothing -> do
@@ -85,7 +96,7 @@ proxy proxydone servermode clientside remoteside othermessage protoerrhandler =
 				client $ net $ sendMessage $ VERSION v
   where
 	ClientSide clientrunst clientconn = clientside
-	RemoteSide remoterunst remoteconn = remoteside
+	RemoteSide remoterunst remoteconn remoteuuid = remoteside
 	
 	remote = liftIO . runNetProto remoterunst remoteconn
 	client = liftIO . runNetProto clientrunst clientconn
@@ -104,16 +115,19 @@ proxy proxydone servermode clientside remoteside othermessage protoerrhandler =
 
 	proxyclientmessage Nothing = proxydone
 	proxyclientmessage (Just message) = case message of
-		CHECKPRESENT _ -> proxyresponse message
+		CHECKPRESENT _ ->
-		LOCKCONTENT _ -> proxyresponse message
+			proxyresponse message (const proxynextclientmessage)
-		UNLOCKCONTENT -> proxynoresponse message
+		LOCKCONTENT _ ->
-		REMOVE _ -> 
+			proxyresponse message (const proxynextclientmessage)
+		UNLOCKCONTENT ->
+			proxynoresponse message proxynextclientmessage
+		REMOVE k -> 
 			servermodechecker checkREMOVEServerMode $
-				proxyresponse message
+				handleREMOVE k message
 		GET _ _ _ -> handleGET message
-		PUT _ _ ->
+		PUT _ k ->
 			servermodechecker checkPUTServerMode $
-				handlePUT message
+				handlePUT k message
 		-- These messages involve the git repository, not the
 		-- annex. So they affect the git repository of the proxy,
 		-- not the remote.
@@ -144,15 +158,14 @@ proxy proxydone servermode clientside remoteside othermessage protoerrhandler =
 		VERSION _ -> protoerr
 
 	-- Send a message to the remote, send its response back to the
-	-- client, and proceed to proxying the next message from the
+	-- client, and pass it to the continuation.
-	-- client.
+	proxyresponse message a = getresponse remote message $ \resp ->
-	proxyresponse message = getresponse remote message $ \resp ->
+		protoerrhandler (a resp) $
-		protoerrhandler proxynextclientmessage $
 			client $ net $ sendMessage resp
 	
 	-- Send a message to the remote, that it will not respond to.
-	proxynoresponse message =
+	proxynoresponse message a =
-		protoerrhandler proxynextclientmessage $
+		protoerrhandler a $
 			remote $ net $ sendMessage message
 	
 	-- Send a message to the endpoint and get back its response.
@@ -168,24 +181,32 @@ proxy proxydone servermode clientside remoteside othermessage protoerrhandler =
 	withresp _ Nothing = proxydone
 
 	-- Read a message from one party, send it to the other,
-	-- and then call the continuation.
+	-- and then pass the message to the continuation.
 	relayonemessage from to cont =
 		flip protoerrhandler (from $ net $ receiveMessage) $
-			withresp $ \resp ->
+			withresp $ \message ->
-				protoerrhandler cont $
+				protoerrhandler (cont message) $
-					to $ net $ sendMessage resp
+					to $ net $ sendMessage message
 	
 	protoerr = do
 		_ <- client $ net $ sendMessage (ERROR "protocol error")
 		giveup "protocol error"
 		
+	handleREMOVE k message =
+		proxyresponse message $ \resp () -> do
+			case resp of
+				SUCCESS -> removedContent proxymethods
+					remoteuuid k
+				_ -> return ()
+			proxynextclientmessage ()
+
 	handleGET message = getresponse remote message $ withDATA relayGET
 
-	handlePUT message = getresponse remote message $ \resp -> case resp of
+	handlePUT k message = getresponse remote message $ \resp -> case resp of
 		ALREADY_HAVE -> protoerrhandler proxynextclientmessage $
 			client $ net $ sendMessage resp
 		PUT_FROM _ -> 
-			getresponse client resp $ withDATA relayPUT
+			getresponse client resp $ withDATA (relayPUT k)
 		_ -> protoerr
 
 	withDATA a message@(DATA len) = a len message
@@ -194,12 +215,19 @@ proxy proxydone servermode clientside remoteside othermessage protoerrhandler =
 	relayGET len = relayDATAStart client $
 		relayDATACore len remote client $
 			relayDATAFinish remote client $
-				relayonemessage client remote proxynextclientmessage
+				relayonemessage client remote $
+					const proxynextclientmessage
 	
-	relayPUT len = relayDATAStart remote $
+	relayPUT k len = relayDATAStart remote $
 		relayDATACore len client remote $
 			relayDATAFinish client remote $
-				relayonemessage remote client proxynextclientmessage
+				relayonemessage remote client finished
+	  where
+		finished resp () = do
+			case resp of
+				SUCCESS -> addedContent proxymethods remoteuuid k
+				_ -> return ()
+			proxynextclientmessage ()
 
 	relayDATAStart x receive message =
 		protoerrhandler (\() -> receive) $
@@ -215,5 +243,5 @@ proxy proxydone servermode clientside remoteside othermessage protoerrhandler =
 		ProtocolVersion 0 -> sendsuccessfailure
 		-- Protocol version 1 has a VALID or
 		-- INVALID message after the data.
-		_ -> relayonemessage x y (\() -> sendsuccessfailure)
+		_ -> relayonemessage x y (\_ () -> sendsuccessfailure)
 

doc/todo/git-annex_proxies.mdwn

@@ -39,10 +39,7 @@ For June's work on [[design/passthrough_proxy]], implementation plan:
 3. Implement git-annex-shell proxying to git remotes. (done)
 
 3. Proxy should update location tracking information for proxied remotes,
-   so it is available to other users who sync with it.
+   so it is available to other users who sync with it. (done)
-
-4. Either implement proxying for tor-annex remotes, or prevent
-   listProxied from operating on them.
 
 4. Let `storeKey` return a list of UUIDs where content was stored,
    and make proxies accept uploads directed at them, rather than a specific
@@ -71,3 +68,4 @@ For June's work on [[design/passthrough_proxy]], implementation plan:
 11. indirect uploads (to be considered). See design.
 
 12. Support using a proxy when its url is a P2P address.
+    (Eg tor-annex remotes.)