From c3c525ab804dd11b97db8705143f4b4070c983ee Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 20 Jul 2013 21:18:55 -0400 Subject: When an XMPP server has SRV records, try them, but don't then fall back to the regular host if they all fail. gmail.com has some XMPP SRV records, but does not itself respond to XMPP traffic, although it does accept connections on port 5222. So if a user entered the wrong password, it would try all the SRVs and fall back to trying gmail, and hang at that point. This seems the right thing to do, not just a workaround. --- Assistant/XMPP/Client.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) (limited to 'Assistant') diff --git a/Assistant/XMPP/Client.hs b/Assistant/XMPP/Client.hs index 960073036..677bb2ff3 100644 --- a/Assistant/XMPP/Client.hs +++ b/Assistant/XMPP/Client.hs @@ -34,17 +34,20 @@ connectXMPP c a = case parseJID (xmppJID c) of {- Do a SRV lookup, but if it fails, fall back to the cached xmppHostname. -} connectXMPP' :: JID -> XMPPCreds -> (JID -> XMPP a) -> IO [(HostPort, Either SomeException ())] -connectXMPP' jid c a = reverse <$> (go [] =<< lookupSRV srvrecord) +connectXMPP' jid c a = reverse <$> (handle =<< lookupSRV srvrecord) where srvrecord = mkSRVTcp "xmpp-client" $ T.unpack $ strDomain $ jidDomain jid serverjid = JID Nothing (jidDomain jid) Nothing - go l [] = do + handle [] = do let h = xmppHostname c let p = PortNumber $ fromIntegral $ xmppPort c r <- run h p $ a jid - return (r : l) + return [r] + handle srvs = go [] srvs + + go l [] = return l go l ((h,p):rest) = do {- Try each SRV record in turn, until one connects, - at which point the MVar will be full. -} -- cgit v1.2.3