send git-annex tag in initial presence

Will be used for finding other git-annex clients for pairing
This commit is contained in:
Joey Hess 2012-10-28 17:07:29 -04:00
parent e7df22916d
commit 64e1d7b579
3 changed files with 14 additions and 8 deletions

View file

@ -46,6 +46,7 @@ pushNotifierThread st dstatus pushnotifier = NamedThread thisThread $
void $ connectXMPP c $ \jid -> do
fulljid <- bindJID jid
liftIO $ debug thisThread ["XMPP connected", show fulljid]
putStanza $ gitAnnexPresence gitAnnexSignature
s <- getSession
_ <- liftIO $ forkIO $ void $ runXMPP s $
receivenotifications
@ -62,10 +63,7 @@ pushNotifierThread st dstatus pushnotifier = NamedThread thisThread $
sendnotifications = forever $ do
us <- liftIO $ waitPush pushnotifier
let payload = [extendedAway, encodePushNotification us]
let notification = (emptyPresence PresenceAvailable)
{ presencePayloads = payload }
putStanza notification
putStanza $ gitAnnexPresence $ encodePushNotification us
receivenotifications = forever $ do
s <- getStanza

View file

@ -84,16 +84,23 @@ xmppCredsFile = do
dir <- fromRepo gitAnnexCredsDir
return $ dir </> "notify-xmpp"
{- Marks the client as extended away. -}
extendedAway :: Element
extendedAway = Element (Name (T.pack "show") Nothing Nothing) []
[NodeContent $ ContentText $ T.pack "xa"]
{- A presence with a git-annex tag in it. -}
gitAnnexPresence :: Element -> Presence
gitAnnexPresence tag = (emptyPresence PresenceAvailable)
{ presencePayloads = [extendedAway, tag] }
where
extendedAway = Element (Name (T.pack "show") Nothing Nothing) []
[NodeContent $ ContentText $ T.pack "xa"]
{- Name of a git-annex tag, in our own XML namespace.
- (Not using a namespace URL to avoid unnecessary bloat.) -}
gitAnnexTagName :: Name
gitAnnexTagName = Name (T.pack "git-annex") (Just $ T.pack "git-annex") Nothing
{- A git-annex tag, to let other clients know we're a git-annex client too. -}
gitAnnexSignature :: Element
gitAnnexSignature = Element gitAnnexTagName [] []
pushAttr :: Name
pushAttr = Name (T.pack "push") Nothing Nothing

View file

@ -7,6 +7,7 @@ who share a repository, that is stored in the [[cloud]].
* Prevent idle disconnection. Probably means sending or receiving pings,
but would prefer to avoid eg pinging every 60 seconds as some clients do.
* XMPP pairing
* git pushes over XMPP (needed for pairing, but also awesome on their own)
## design goals