diff --git a/Config.hs b/Config.hs index 54cf082..ddb0ee1 100644 --- a/Config.hs +++ b/Config.hs @@ -27,6 +27,7 @@ data Config = Config { componentJid :: XMPP.JID, server :: ServerConfig, secret :: Text, + nick :: Text, mucs :: [Bridge] } deriving (Dhall.Generic, Dhall.FromDhall, Show) diff --git a/Router.hs b/Router.hs index a74e95c..c2dfd21 100644 --- a/Router.hs +++ b/Router.hs @@ -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 diff --git a/config.dhall.example b/config.dhall.example index a54352b..5207a69 100644 --- a/config.dhall.example +++ b/config.dhall.example @@ -1,4 +1,5 @@ { + nick = "cheogram", componentJid = "component.localhost", secret = "secret", server = { diff --git a/gateway.hs b/gateway.hs index 50ea53e..21c8073 100644 --- a/gateway.hs +++ b/gateway.hs @@ -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,