From 050a3d83c31f44eef4d09597c1c728a81c225107 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Tue, 17 Sep 2013 12:23:06 +0300 Subject: [PATCH 1/2] dns 1.0 support --- source/Network/Xmpp/Stream.hs | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/source/Network/Xmpp/Stream.hs b/source/Network/Xmpp/Stream.hs index 4fad0f2..0d3dc74 100644 --- a/source/Network/Xmpp/Stream.hs +++ b/source/Network/Xmpp/Stream.hs @@ -1,5 +1,6 @@ {-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} @@ -624,13 +625,21 @@ connectTcp ((address, port):remainder) = do debugM "Pontarius.Xmpp" "Connection to HostName could not be established." connectTcp remainder +#if MIN_VERSION_dns(1, 0, 0) +fixDnsResult :: Either e a -> Maybe a +fixDnsResult = either (const Nothing) Just +#else +fixDnsResult :: Maybe a -> Maybe a +fixDnsResult = id +#endif + -- Makes an AAAA query to acquire a IPs, and tries to connect to all of them. If -- a handle can not be acquired this way, an analogous A query is performed. -- Surpresses all IO exceptions. resolvAndConnectTcp :: ResolvSeed -> Domain -> Int -> IO (Maybe Handle) resolvAndConnectTcp resolvSeed domain port = do aaaaResults <- (Ex.try $ rethrowErrorCall $ withResolver resolvSeed $ - \resolver -> lookupAAAA resolver domain) :: IO (Either Ex.IOException (Maybe [IPv6])) + \resolver -> fmap fixDnsResult $ lookupAAAA resolver domain) :: IO (Either Ex.IOException (Maybe [IPv6])) handle <- case aaaaResults of Right Nothing -> return Nothing Right (Just ipv6s) -> connectTcp $ @@ -641,7 +650,7 @@ resolvAndConnectTcp resolvSeed domain port = do case handle of Nothing -> do aResults <- (Ex.try $ rethrowErrorCall $ withResolver resolvSeed $ - \resolver -> lookupA resolver domain) :: IO (Either Ex.IOException (Maybe [IPv4])) + \resolver -> fmap fixDnsResult $ lookupA resolver domain) :: IO (Either Ex.IOException (Maybe [IPv4])) handle' <- case aResults of Left _ -> return Nothing Right Nothing -> return Nothing @@ -684,7 +693,7 @@ srvLookup realm resolvSeed = ErrorT $ do result <- Ex.try $ rethrowErrorCall $ withResolver resolvSeed $ \resolver -> do srvResult <- lookupSRV resolver $ BSC8.pack $ "_xmpp-client._tcp." ++ (Text.unpack realm) ++ "." - case srvResult of + case fixDnsResult srvResult of Just [(_, _, _, ".")] -> do debugM "Pontarius.Xmpp" $ "\".\" SRV result returned." return $ Just [] From 193e79c051e4497a20d91aa2bd3e473ae0f5dd3d Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Tue, 17 Sep 2013 12:25:43 +0300 Subject: [PATCH 2/2] network 2.3.1.0 support --- pontarius-xmpp.cabal | 2 +- source/Network/Xmpp/Stream.hs | 13 ++++++++++++- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/pontarius-xmpp.cabal b/pontarius-xmpp.cabal index 03c0666..0889cea 100644 --- a/pontarius-xmpp.cabal +++ b/pontarius-xmpp.cabal @@ -56,7 +56,7 @@ Library , iproute >=1.2.4 , lifted-base >=0.1.0.1 , mtl >=2.0.0.0 - , network >=2.4.1.0 + , network >=2.3.1.0 , pureMD5 >=2.1.2.1 , resourcet >=0.3.0 , random >=1.0.0.0 diff --git a/source/Network/Xmpp/Stream.hs b/source/Network/Xmpp/Stream.hs index 0d3dc74..8dba80f 100644 --- a/source/Network/Xmpp/Stream.hs +++ b/source/Network/Xmpp/Stream.hs @@ -608,6 +608,17 @@ connectSrv config host = do "The hostname could not be validated." throwError XmppIllegalTcpDetails +showPort :: PortID -> String +#if MIN_VERSION_network(2, 4, 1) +showPort = show +#else +showPort (PortNumber x) = "PortNumber " ++ show x +showPort (Service x) = "Service " ++ show x +#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) +showPort (UnixSocket x) = "UnixSocket " ++ show x +#endif +#endif + -- Connects to a list of addresses and ports. Surpresses any exceptions from -- connectTcp. connectTcp :: [(HostName, PortID)] -> IO (Maybe Handle) @@ -615,7 +626,7 @@ connectTcp [] = return Nothing connectTcp ((address, port):remainder) = do result <- Ex.try $ (do debugM "Pontarius.Xmpp" $ "Connecting to " ++ address ++ " on port " ++ - (show port) ++ "." + (showPort port) ++ "." connectTo address port) :: IO (Either Ex.IOException Handle) case result of Right handle -> do