M Config.hs => Config.hs +1 -0
@@ 27,6 27,7 @@ data Config = Config {
componentJid :: XMPP.JID,
server :: ServerConfig,
secret :: Text,
+ nick :: Text,
mucs :: [Bridge]
} deriving (Dhall.Generic, Dhall.FromDhall, Show)
M Router.hs => Router.hs +1 -3
@@ 7,8 7,6 @@ import qualified Network.Protocol.XMPP as XMPP
import Util
-import Debug.Trace
-
runRoutedComponent ::
XMPP.Server
-> Text
@@ 18,7 16,7 @@ runRoutedComponent server secret =
ExceptT . XMPP.runComponent server secret . (runRouted =<<)
runRouted :: Routes -> XMPP.XMPP ()
-runRouted routes = forever $ XMPP.getStanza >>= (void . forkXMPP . handle . traceShowId)
+runRouted routes = forever $ XMPP.getStanza >>= (void . forkXMPP . handle)
where
handle (XMPP.ReceivedPresence presence@XMPP.Presence {
XMPP.presenceType = XMPP.PresenceProbe
M config.dhall.example => config.dhall.example +1 -0
@@ 1,4 1,5 @@
{
+ nick = "cheogram",
componentJid = "component.localhost",
secret = "secret",
server = {
M gateway.hs => gateway.hs +11 -8
@@ 56,16 56,16 @@ handlePresence config presence@XMPP.Presence {
XMPP.presenceTo = Just to,
XMPP.presencePayloads = p
}
- | bareTxt to /= bareTxt (Config.componentJid config) =
+ | bareTxt to /= s"bridge@" ++ XMPP.formatJID (Config.componentJid config) =
-- This is to one of our ghosts, so just ignore it
return ()
| hasMucCode 110 presence = return () -- ignore self presence
| Just resource <- XMPP.jidResource from,
- not (s"/" `T.isInfixOf` XMPP.strResource resource) = forM_ (targets config from) $ \target ->
+ not (s"|" `T.isInfixOf` XMPP.strResource resource) = forM_ (targets config from) $ \target ->
XMPP.putStanza $ presence {
XMPP.presenceFrom = Just (proxyJid config from),
XMPP.presenceTo = XMPP.parseJID $
- bareTxt target ++ s"/" ++ XMPP.strResource resource ++ s"/X",
+ bareTxt target ++ s"/" ++ XMPP.strResource resource ++ s"|X",
XMPP.presencePayloads = map (\payload ->
case XML.isNamed (s"{http://jabber.org/protocol/muc#user}x") payload of
[_] -> mucJoinX
@@ 98,7 98,7 @@ handleGroupChat config message@XMPP.Message {
XMPP.messageFrom = Just from,
XMPP.messageTo = Just to
}
- | bareTxt to /= bareTxt (Config.componentJid config) =
+ | bareTxt to /= s"bridge@" ++ XMPP.formatJID (Config.componentJid config) =
-- This is to one of our ghosts, so just ignore it
return ()
| otherwise = forM_ (targets config from) $ \target ->
@@ 129,9 129,9 @@ handleMessage config message@XMPP.Message {
-- If we get a direct message from a non-MUC source
-- check if there are any MUCs bridged to the given target
-- with a domain matching the domain of the from
- -- and if so use the localpart as a nick from that source
+ -- and if so use the localpart (minus any %suffix) as a nick from that source
maybeFakeFrom = (XMPP.parseJID =<<) $
- fmap ((++ s"/" ++ XMPP.strNode fromNode) . bareTxt) $
+ fmap ((++ s"/" ++ T.takeWhile (/='%') (XMPP.strNode fromNode)) . bareTxt) $
find (\source -> XMPP.jidDomain source == XMPP.jidDomain from) $
targets config =<< justZ target
handleMessage _ _ = return ()
@@ 162,11 162,14 @@ main = do
(Config.host $ Config.server config)
(Config.port $ Config.server config)
+ let Just bridgeJid = XMPP.parseJID $ s"bridge@" ++
+ XMPP.formatJID (Config.componentJid config) ++ s"/bridge"
+
exceptT print return $
runRoutedComponent server (Config.secret config) $ do
forM_ (Config.mucs config) $ \bridge -> do
- XMPP.putStanza $ mucJoin (Config.muc1 bridge) (s"cheogram")
- XMPP.putStanza $ mucJoin (Config.muc2 bridge) (s"cheogram")
+ XMPP.putStanza $ (mucJoin (Config.muc1 bridge) (Config.nick config)) { XMPP.presenceFrom = Just bridgeJid }
+ XMPP.putStanza $ (mucJoin (Config.muc2 bridge) (Config.nick config)) { XMPP.presenceFrom = Just bridgeJid }
return $ defaultRoutes {
presenceRoute = handlePresence config,
presenceErrorRoute = handlePresenceError,