add uuid to all xmpp messages

(Except for the actual streaming of receive-pack through XMPP, which
can only run once we've gotten an appropriate uuid in a push initiation
message.)

Pushes are now only initiated when the initiation message comes from a
known uuid. This allows multiple distinct repositories to use the same xmpp
address.

Note: This probably breaks initial push after xmpp pairing, because at that
point we may not know about the paired uuid, and so reject the push from
it. It won't break in simple cases, because the annex-uuid of the remote
is checked. However, when there are multiple clients behind a single xmpp
address, only uuid of the first is recorded in annex-uuid, and so any
pushes from the others will be rejected (unless the first remote pushes their
uuids to us beforehand.

1 files changed, 16 insertions, 11 deletions

diff --git a/Assistant/XMPP/Git.hs b/Assistant/XMPP/Git.hs
index 46c8cb173..c1605bee2 100644
--- a/Assistant/XMPP/Git.hs
+++ b/Assistant/XMPP/Git.hs
@@ -21,6 +21,7 @@ import Assistant.Sync
 import qualified Command.Sync
 import qualified Annex.Branch
 import Annex.UUID
+import Logs.UUID
 import Annex.TaggedPush
 import Config
 import Git
@@ -84,7 +85,8 @@ makeXMPPGitRemote buddyname jid u = do
  -}
 xmppPush :: ClientID -> (Git.Repo -> IO Bool) -> (NetMessage -> Assistant ()) -> Assistant Bool
 xmppPush cid gitpush handledeferred = runPush SendPack cid handledeferred $ do
-	sendNetMessage $ Pushing cid StartingPush
+	u <- liftAnnex getUUID
+	sendNetMessage $ Pushing cid (StartingPush u)
 
 	(Fd inf, writepush) <- liftIO createPipe
 	(readpush, Fd outf) <- liftIO createPipe
@@ -247,26 +249,29 @@ xmppReceivePack cid handledeferred = runPush ReceivePack cid handledeferred $ do
 					hClose inh
 					killThread =<< myThreadId
 
-xmppRemotes :: ClientID -> Assistant [Remote]
-xmppRemotes cid = case baseJID <$> parseJID cid of
+xmppRemotes :: ClientID -> UUID -> Assistant [Remote]
+xmppRemotes cid theiruuid = case baseJID <$> parseJID cid of
 	Nothing -> return []
 	Just jid -> do
 		let loc = gitXMPPLocation jid
-		filter (matching loc . Remote.repo) . syncGitRemotes 
+		um <- liftAnnex uuidMap
+		filter (matching loc . Remote.repo) . filter (knownuuid um) . syncGitRemotes 
 			<$> getDaemonStatus
   where
 	matching loc r = repoIsUrl r && repoLocation r == loc
+	knownuuid um r = Remote.uuid r == theiruuid || M.member theiruuid um
 
 handlePushInitiation :: (Remote -> Assistant ()) -> NetMessage -> Assistant ()
-handlePushInitiation _ (Pushing cid CanPush) =
-	unlessM (null <$> xmppRemotes cid) $ 
-		sendNetMessage $ Pushing cid PushRequest
-handlePushInitiation checkcloudrepos (Pushing cid PushRequest) =
+handlePushInitiation _ (Pushing cid (CanPush theiruuid)) =
+	unlessM (null <$> xmppRemotes cid theiruuid) $ do
+		u <- liftAnnex getUUID
+		sendNetMessage $ Pushing cid (PushRequest u)
+handlePushInitiation checkcloudrepos (Pushing cid (PushRequest theiruuid)) =
 	go =<< liftAnnex (inRepo Git.Branch.current)
   where
 	go Nothing = noop
 	go (Just branch) = do
-		rs <- xmppRemotes cid
+		rs <- xmppRemotes cid theiruuid
 		liftAnnex $ Annex.Branch.commit "update"
 		(g, u) <- liftAnnex $ (,)
 			<$> gitRepo
@@ -279,8 +284,8 @@ handlePushInitiation checkcloudrepos (Pushing cid PushRequest) =
 					(taggedPush u selfjid branch r)
 					(handleDeferred checkcloudrepos)
 			checkcloudrepos r
-handlePushInitiation checkcloudrepos (Pushing cid StartingPush) = do
-	rs <- xmppRemotes cid
+handlePushInitiation checkcloudrepos (Pushing cid (StartingPush theiruuid)) = do
+	rs <- xmppRemotes cid theiruuid
 	unless (null rs) $ do
 		void $ alertWhile (syncAlert rs) $
 			xmppReceivePack cid (handleDeferred checkcloudrepos)