Actually works with biboumi now
This commit is contained in:
parent
d0cf3b4b11
commit
b160817afb
|
@ -27,6 +27,7 @@ data Config = Config {
|
||||||
componentJid :: XMPP.JID,
|
componentJid :: XMPP.JID,
|
||||||
server :: ServerConfig,
|
server :: ServerConfig,
|
||||||
secret :: Text,
|
secret :: Text,
|
||||||
|
nick :: Text,
|
||||||
mucs :: [Bridge]
|
mucs :: [Bridge]
|
||||||
} deriving (Dhall.Generic, Dhall.FromDhall, Show)
|
} deriving (Dhall.Generic, Dhall.FromDhall, Show)
|
||||||
|
|
||||||
|
|
|
@ -7,8 +7,6 @@ import qualified Network.Protocol.XMPP as XMPP
|
||||||
|
|
||||||
import Util
|
import Util
|
||||||
|
|
||||||
import Debug.Trace
|
|
||||||
|
|
||||||
runRoutedComponent ::
|
runRoutedComponent ::
|
||||||
XMPP.Server
|
XMPP.Server
|
||||||
-> Text
|
-> Text
|
||||||
|
@ -18,7 +16,7 @@ runRoutedComponent server secret =
|
||||||
ExceptT . XMPP.runComponent server secret . (runRouted =<<)
|
ExceptT . XMPP.runComponent server secret . (runRouted =<<)
|
||||||
|
|
||||||
runRouted :: Routes -> XMPP.XMPP ()
|
runRouted :: Routes -> XMPP.XMPP ()
|
||||||
runRouted routes = forever $ XMPP.getStanza >>= (void . forkXMPP . handle . traceShowId)
|
runRouted routes = forever $ XMPP.getStanza >>= (void . forkXMPP . handle)
|
||||||
where
|
where
|
||||||
handle (XMPP.ReceivedPresence presence@XMPP.Presence {
|
handle (XMPP.ReceivedPresence presence@XMPP.Presence {
|
||||||
XMPP.presenceType = XMPP.PresenceProbe
|
XMPP.presenceType = XMPP.PresenceProbe
|
||||||
|
|
|
@ -1,4 +1,5 @@
|
||||||
{
|
{
|
||||||
|
nick = "cheogram",
|
||||||
componentJid = "component.localhost",
|
componentJid = "component.localhost",
|
||||||
secret = "secret",
|
secret = "secret",
|
||||||
server = {
|
server = {
|
||||||
|
|
19
gateway.hs
19
gateway.hs
|
@ -56,16 +56,16 @@ handlePresence config presence@XMPP.Presence {
|
||||||
XMPP.presenceTo = Just to,
|
XMPP.presenceTo = Just to,
|
||||||
XMPP.presencePayloads = p
|
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
|
-- This is to one of our ghosts, so just ignore it
|
||||||
return ()
|
return ()
|
||||||
| hasMucCode 110 presence = return () -- ignore self presence
|
| hasMucCode 110 presence = return () -- ignore self presence
|
||||||
| Just resource <- XMPP.jidResource from,
|
| 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.putStanza $ presence {
|
||||||
XMPP.presenceFrom = Just (proxyJid config from),
|
XMPP.presenceFrom = Just (proxyJid config from),
|
||||||
XMPP.presenceTo = XMPP.parseJID $
|
XMPP.presenceTo = XMPP.parseJID $
|
||||||
bareTxt target ++ s"/" ++ XMPP.strResource resource ++ s"/X",
|
bareTxt target ++ s"/" ++ XMPP.strResource resource ++ s"|X",
|
||||||
XMPP.presencePayloads = map (\payload ->
|
XMPP.presencePayloads = map (\payload ->
|
||||||
case XML.isNamed (s"{http://jabber.org/protocol/muc#user}x") payload of
|
case XML.isNamed (s"{http://jabber.org/protocol/muc#user}x") payload of
|
||||||
[_] -> mucJoinX
|
[_] -> mucJoinX
|
||||||
|
@ -98,7 +98,7 @@ handleGroupChat config message@XMPP.Message {
|
||||||
XMPP.messageFrom = Just from,
|
XMPP.messageFrom = Just from,
|
||||||
XMPP.messageTo = Just to
|
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
|
-- This is to one of our ghosts, so just ignore it
|
||||||
return ()
|
return ()
|
||||||
| otherwise = forM_ (targets config from) $ \target ->
|
| 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
|
-- If we get a direct message from a non-MUC source
|
||||||
-- check if there are any MUCs bridged to the given target
|
-- check if there are any MUCs bridged to the given target
|
||||||
-- with a domain matching the domain of the from
|
-- 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 =<<) $
|
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) $
|
find (\source -> XMPP.jidDomain source == XMPP.jidDomain from) $
|
||||||
targets config =<< justZ target
|
targets config =<< justZ target
|
||||||
handleMessage _ _ = return ()
|
handleMessage _ _ = return ()
|
||||||
|
@ -162,11 +162,14 @@ main = do
|
||||||
(Config.host $ Config.server config)
|
(Config.host $ Config.server config)
|
||||||
(Config.port $ 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 $
|
exceptT print return $
|
||||||
runRoutedComponent server (Config.secret config) $ do
|
runRoutedComponent server (Config.secret config) $ do
|
||||||
forM_ (Config.mucs config) $ \bridge -> do
|
forM_ (Config.mucs config) $ \bridge -> do
|
||||||
XMPP.putStanza $ mucJoin (Config.muc1 bridge) (s"cheogram")
|
XMPP.putStanza $ (mucJoin (Config.muc1 bridge) (Config.nick config)) { XMPP.presenceFrom = Just bridgeJid }
|
||||||
XMPP.putStanza $ mucJoin (Config.muc2 bridge) (s"cheogram")
|
XMPP.putStanza $ (mucJoin (Config.muc2 bridge) (Config.nick config)) { XMPP.presenceFrom = Just bridgeJid }
|
||||||
return $ defaultRoutes {
|
return $ defaultRoutes {
|
||||||
presenceRoute = handlePresence config,
|
presenceRoute = handlePresence config,
|
||||||
presenceErrorRoute = handlePresenceError,
|
presenceErrorRoute = handlePresenceError,
|
||||||
|
|
Loading…
Reference in New Issue