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.
This commit is contained in:
Joey Hess 2012-11-10 15:33:12 -04:00
parent ec186d6369
commit 41085cdc8c
3 changed files with 36 additions and 18 deletions

View file

@ -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