1 files changed, 14 insertions(+), 9 deletions(-)

M jabber-iq-gateway-web.hs

@@ 18,16 18,11 @@ import IQManager
 import Router
 import Util
 
-runClient :: XMPP.JID -> Text -> XMPP.XMPP a -> IO (Either XMPP.Error a)
-runClient jid =
+runClient :: XMPP.Server -> XMPP.JID -> Text -> XMPP.XMPP a -> IO (Either XMPP.Error a)
+runClient server jid =
 	XMPP.runClient server jid jidStrNode
 	where
-	-- This is right unless there is an SRV record, which we don't check for
 	Just jidStrNode = XMPP.strNode <$> XMPP.jidNode jid
-	jidStrDomain = XMPP.strDomain $ XMPP.jidDomain jid
-	Just domainJid = XMPP.parseJID jidStrDomain
-	domainStr = textToString jidStrDomain
-	server = XMPP.Server domainJid domainStr (PortNumber 5222)
 
 webPost :: (XMPP.IQ -> IO (Maybe XMPP.IQ)) -> XMPP.JID -> Wai.Application
 webPost sendIQ toJid req = (>>=) $ do


@@ 110,12 105,22 @@ web sendIQ req
 
 main :: IO ()
 main = do
-	[rpcJidStr, rpcPassword] <- getArgs
+	rpcJidStr:rpcPassword:rest <- getArgs
+
+	-- This is right unless there is an SRV record, which we don't check for
 	let Just rpcJid = XMPP.parseJID rpcJidStr
+	let jidStrDomain = XMPP.strDomain $ XMPP.jidDomain rpcJid
+	let Just domainJid = XMPP.parseJID jidStrDomain
+	let domainStr = textToString jidStrDomain
+
+	let server = case (fmap textToString rest, map XMPP.parseJID rest) of
+		([serverStr], [Just serverJid]) -> XMPP.Server serverJid serverStr (PortNumber 5222)
+		_ -> XMPP.Server domainJid domainStr (PortNumber 5222)
+
 	sendIQChan <- atomicUIO STM.newTChan
 
 	void $ UIO.fork $ do
-		fmap (either (error . show) (const ())) $ fromIO_ $ runClient rpcJid rpcPassword $ do
+		fmap (either (error . show) (const ())) $ fromIO_ $ runClient server rpcJid rpcPassword $ do
 			void $ XMPP.bindJID rpcJid
 			(sendIQ, iqReceived) <- iqManager
 			void $ forkXMPP $ runRouted $ defaultRoutes {