set negative XMPP presence priority

This should help prevent git-annex clients receiving messages that
were intended for normal clients they're sharing the account with.

Changed XMPP protocol use to always send chat messages directed at the
specific client, as the negative priority blocks less directed messages.

3 files changed, 36 insertions, 18 deletions

diff --git a/Assistant/Threads/XMPPClient.hs b/Assistant/Threads/XMPPClient.hs
index ee1db0666..12ec9d550 100644
--- a/Assistant/Threads/XMPPClient.hs
+++ b/Assistant/Threads/XMPPClient.hs
@@ -137,7 +137,13 @@ decodeStanza selfjid s@(ReceivedMessage m)
 	| otherwise = [fromMaybe (Unknown s) (GotNetMessage <$> decodeMessage m)]
 decodeStanza _ s = [Unknown s]
 
-{- Waits for a NetMessager message to be sent, and relays it to XMPP. -}
+{- Waits for a NetMessager message to be sent, and relays it to XMPP.
+ -
+ - Chat messages must be directed to specific clients, not a base
+ - account JID, due to git-annex clients using a negative presence priority.
+ - PairingNotification messages are always directed at specific
+ - clients, but Pushing messages are sometimes not, and need to be exploded.
+ -}
 relayNetMessage :: JID -> Assistant (XMPP ())
 relayNetMessage selfjid = convert =<< waitNetMessage
   where
@@ -146,8 +152,13 @@ relayNetMessage selfjid = convert =<< waitNetMessage
 	convert (PairingNotification stage c u) = withclient c $ \tojid -> do
 		changeBuddyPairing tojid True
 		return $ putStanza $ pairingNotification stage u tojid selfjid
-	convert (Pushing c pushstage) = withclient c $ \tojid -> 
-		return $ putStanza $ pushMessage pushstage tojid selfjid
+	convert (Pushing c pushstage) = withclient c $ \tojid -> do
+		if tojid == baseJID tojid
+			then do
+				bud <- getBuddy (genBuddyKey tojid) <<~ buddyList
+				return $ forM_ (maybe [] (S.toList . buddyAssistants) bud) $ \(Client jid) ->
+					putStanza $ pushMessage pushstage jid selfjid
+			else return $ putStanza $ pushMessage pushstage tojid selfjid
 
 	withclient c a = case parseJID c of
 		Nothing -> return noop
diff --git a/Assistant/XMPP.hs b/Assistant/XMPP.hs
index e473b5305..2c0004403 100644
--- a/Assistant/XMPP.hs
+++ b/Assistant/XMPP.hs
@@ -52,8 +52,9 @@ instance GitAnnexTaggable Message where
 	extractGitAnnexTag = headMaybe . filter isGitAnnexTag . messagePayloads
 
 instance GitAnnexTaggable Presence where
-	-- always mark extended away
-	insertGitAnnexTag p elt = p { presencePayloads = extendedAway : elt : presencePayloads p }
+	-- always mark extended away and set presence priority to negative
+	insertGitAnnexTag p elt = p
+		{ presencePayloads = extendedAway : negativePriority : elt : presencePayloads p }
 	extractGitAnnexTag = headMaybe . filter isGitAnnexTag . presencePayloads
 
 data GitAnnexTagInfo = GitAnnexTagInfo
@@ -208,6 +209,10 @@ silentMessage = (emptyMessage MessageChat)
 extendedAway :: Element
 extendedAway = Element "show" [] [NodeContent $ ContentText "xa"]
 
+{- Add to a presence to give it a negative priority. -}
+negativePriority :: Element
+negativePriority = Element "priority" [] [NodeContent $ ContentText "-1"]
+
 pushAttr :: Name
 pushAttr = "push"
 
diff --git a/doc/design/assistant/xmpp.mdwn b/doc/design/assistant/xmpp.mdwn
index 9ab8eabe6..80c0c57d7 100644
--- a/doc/design/assistant/xmpp.mdwn
+++ b/doc/design/assistant/xmpp.mdwn
@@ -29,15 +29,20 @@ who share a repository, that is stored in the [[cloud]].
 ## protocol
 
 To avoid relying on XMPP extensions, git-annex communicates
-using presence messages (which always mark it as extended away),
-and chat messages (with empty body tags, so clients don't display them).
+using presence messages, and chat messages (with empty body tags,
+so clients don't display them).
 
-To these messages, it adds its own tag as
+git-annex sets a negative presence priority, to avoid any regular messages
+getting eaten by its clients. It also sets itself extended away.
+Note that this means that chat messages always have to be directed at
+specific git-annex clients.
+
+To the presence and chat messages, it adds its own tag as
 [extended content](http://xmpp.org/rfcs/rfc6121.html#presence-extended).
 The xml namespace is "git-annex" (not an URL because I hate wasting bandwidth).
 
 To indicate it's pushed changes to a git repo with a given UUID, a message
-that should be sent to all buddies and other clients using the account (no
+that is sent to all buddies and other clients using the account (no
 explicit pairing needed), it uses a broadcast presence message containing:
 
 	<git-annex xmlns='git-annex' push="uuid[,uuid...]" />
@@ -50,14 +55,15 @@ containing:
 
 	<git-annex xmlns='git-annex' query="" />
 
-For pairing, a chat message is sent, containing:
+For pairing, a chat message is sent to every known git-annex client,
+containing:
 
 	<git-annex xmlns='git-annex' pairing="PairReq|PairAck|PairDone uuid" />
 
 ### git push over XMPP
 
 To indicate that we could push over XMPP, a chat message is sent,
-to the accounts associated with known XMPP remotes.
+to each known client of each XMPP remote.
 
 	<git-annex xmlns='git-annex' canpush="" />
 
@@ -66,19 +72,15 @@ To request that a remote push to us, a chat message can be sent.
 	<git-annex xmlns='git-annex' pushrequest="uuid" />
 
 When replying to an xmpppush message, this is directed at the specific
-client that indicated it could push. But it can also be sent to 
-the account associated with an XMPP remote to solicit pushes from all clients.
+client that indicated it could push. To solicit pushes from all clients,
+the message has to be sent directed indiviaually to each client.
 
 When a peer is ready to send a git push, it sends:
 
 	<git-annex xmlns='git-annex' startingpush="uuid" />
 
-If that's a response to a pushrequest, it'll be directed at only the client
-that requested the push. If a push request is being initiated, it'll be sent
-to the account assicated with the remote.
-
 The receiver runs `git receive-pack`, and sends back its output in
-one or more chat messages, directed to a specific client:
+one or more chat messages, directed to the client that is pushing:
 
 	<git-annex xmlns='git-annex' rp="">
 	007b27ca394d26a05d9b6beefa1b07da456caa2157d7 refs/heads/git-annex report-status delete-refs side-band-64k quiet ofs-delta