diff options
| -rw-r--r-- | Assistant/XMPP/Client.hs | 9 | ||||
| -rw-r--r-- | debian/changelog | 2 |
2 files changed, 8 insertions, 3 deletions
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. -} diff --git a/debian/changelog b/debian/changelog index a0e4283e7..d78f1a599 100644 --- a/debian/changelog +++ b/debian/changelog @@ -28,6 +28,8 @@ git-annex (4.20130710) UNRELEASED; urgency=low * Bug fix: Adding files that contained a tarball of a git-annex repository, or other content in the first line that looks like a git-annex link, could cause git-annex add to malfunction and lose the file content. + * When an XMPP server has SRV records, try them, but don't then fall + back to the regular host if they all fail. -- Joey Hess <joeyh@debian.org> Tue, 09 Jul 2013 19:17:13 -0400 |