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

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