~singpolyma/cheogram-muc-bridge

06e4b258e96c96d9043481cbc6580b62a7532e6f — Stephen Paul Weber 3 months ago 3b77e21
Detect presence from ghost using custom element

Instead of trying to "remember" who is a ghost based on fragile things like
which nick we asked for, which is subject to race conditions in the case of
rewriting, etc, just send an extra presence payload for a ghost that only we
generate and detect it on inbound.

This will only work if the MUC remembers the actual presence stanza it got and
sends that for all future presences from a member, which the spec doesn't seem
to specifically require, but implementations do (and need to, for things like
avatars to work).
2 files changed, 11 insertions(+), 18 deletions(-)

M Session.hs
M gateway.hs
M Session.hs => Session.hs +6 -17
@@ 65,15 65,6 @@ sendPresence config presence targetMuc =
	sendPresenceToMUC config presence
		(Config.MUC targetMuc Nothing Nothing Nothing) Nothing

isGhost :: (MonadIO m) => Config.Config -> XMPP.JID -> m Bool
isGhost config from = do
	ghost <- liftIO $ DB.query (Config.db config)
		(s"SELECT COUNT(1) FROM sessions WHERE target_muc = ? AND target_nick = ? LIMIT 1")
		(bareTxt from, nick)
	return (ghost /= [DB.Only (0::Int)])
	where
	nick = fromMaybe mempty $ XMPP.strResource <$> XMPP.jidResource from

sendPresenceToMUC :: Config.Config -> XMPP.Presence -> Config.MUC -> Maybe Text -> XMPP.XMPP ()
sendPresenceToMUC config presence@XMPP.Presence {
	XMPP.presenceFrom = Just from@XMPP.JID {


@@ 82,18 73,16 @@ sendPresenceToMUC config presence@XMPP.Presence {
	XMPP.presenceType = typ,
	XMPP.presencePayloads = payloads
} targetMuc tag = do
	ghost <- isGhost config from
	let typ'
		| ghost = XMPP.PresenceUnavailable
		| otherwise = typ
	when (typ' == XMPP.PresenceAvailable) $
		mkSession config typ' (Just from) target
	when (typ == XMPP.PresenceAvailable) $
		mkSession config typ (Just from) target

	XMPP.putStanza $ presence {
			XMPP.presenceType = typ',
			XMPP.presenceType = typ,
			XMPP.presenceFrom = Just (proxyJid config from),
			XMPP.presenceTo = Just target,
			XMPP.presencePayloads = map (\payload ->
			XMPP.presencePayloads = (
				XML.Element (s"{https://ns.soprani.ca/cheogram-muc-bridge/ghost}ghost") [] []
			) : map (\payload ->
				case XML.isNamed (s"{http://jabber.org/protocol/muc#user}x") payload of
					[_] -> mucJoinX
					_ -> payload

M gateway.hs => gateway.hs +5 -1
@@ 42,7 42,8 @@ handlePresence :: Config.Config -> XMPP.Presence -> XMPP.XMPP ()
handlePresence config presence@XMPP.Presence {
	XMPP.presenceFrom = Just from,
	XMPP.presenceTo = Just to,
	XMPP.presenceType = typ
	XMPP.presenceType = typ,
	XMPP.presencePayloads = payloads
}
	| typ == XMPP.PresenceAvailable,
	  hasMucCode 110 presence, -- done joining room


@@ 72,6 73,9 @@ handlePresence config presence@XMPP.Presence {
	| bareTxt to /= bareTxt (Config.bridgeJid config) =
		-- This is to one of our ghosts, so just ignore it
		return ()
	| (_:_) <- XML.isNamed (s"{https://ns.soprani.ca/cheogram-muc-bridge/ghost}ghost") =<< payloads =
		-- This is from one of our ghosts, so just ignore it
		return ()
	| otherwise = forM_ (fullTargets config from) $
			uncurry $ Session.sendPresenceToMUC config presence
handlePresence _ _ = return ()