summaryrefslogtreecommitdiff
path: root/Assistant/Threads/XMPPClient.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-11-10 15:33:12 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-11-10 15:33:12 -0400
commit6608d3561744d7e7c865cdd30f7eff5a7fe3c339 (patch)
tree7851119092b20aac4a9ac75f0b8bdfa6e39dc7e2 /Assistant/Threads/XMPPClient.hs
parentc1c42eb293c9bd7a481adcaf6a9e144438efe390 (diff)
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.
Diffstat (limited to 'Assistant/Threads/XMPPClient.hs')
-rw-r--r--Assistant/Threads/XMPPClient.hs17
1 files changed, 14 insertions, 3 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