diff options
| -rw-r--r-- | Assistant/Threads/PushNotifier.hs | 2 | ||||
| -rw-r--r-- | Utility/SRV.hs | 17 |
2 files changed, 15 insertions, 4 deletions
diff --git a/Assistant/Threads/PushNotifier.hs b/Assistant/Threads/PushNotifier.hs index 2784012f2..0686aac7b 100644 --- a/Assistant/Threads/PushNotifier.hs +++ b/Assistant/Threads/PushNotifier.hs @@ -83,7 +83,7 @@ connectXMPP c a = case parseJID (xmppJID c) of connectXMPP' :: JID -> XMPPCreds -> (JID -> XMPP a) -> IO (Either SomeException ()) connectXMPP' jid c a = go =<< lookupSRV srvrecord where - srvrecord = "_xmpp-client._tcp." ++ (T.unpack $ strDomain $ jidDomain jid) + srvrecord = mkSRVTcp "xmpp-client" (T.unpack $ strDomain $ jidDomain jid) serverjid = JID Nothing (jidDomain jid) Nothing go [] = run (xmppHostname c) diff --git a/Utility/SRV.hs b/Utility/SRV.hs index c30c8bd86..38ac28787 100644 --- a/Utility/SRV.hs +++ b/Utility/SRV.hs @@ -11,6 +11,8 @@ {-# LANGUAGE CPP #-} module Utility.SRV ( + mkSRVTcp, + mkSRV, lookupSRV, ) where @@ -30,12 +32,21 @@ import ADNS.Resolver import Data.Either #endif +newtype SRV = SRV String + type HostPort = (HostName, PortID) +mkSRV :: String -> String -> HostName -> SRV +mkSRV transport protocol host = SRV $ concat + ["_", protocol, ".", transport, ".", host] + +mkSRVTcp :: String -> HostName -> SRV +mkSRVTcp = mkSRV "tcp" + {- Returns an ordered list, with highest priority hosts first. - - On error, returns an empty list. -} -lookupSRV :: HostName -> IO [HostPort] +lookupSRV :: SRV -> IO [HostPort] #ifdef WITH_ADNS lookupSRV srv = initResolver [] $ \resolver -> do r <- catchDefaultIO (Right []) $ @@ -45,8 +56,8 @@ lookupSRV srv = initResolver [] $ \resolver -> do lookupSRV = lookupSRVHost #endif -lookupSRVHost :: HostName -> IO [HostPort] -lookupSRVHost srv +lookupSRVHost :: SRV -> IO [HostPort] +lookupSRVHost (SRV srv) | Build.SysConfig.host = catchDefaultIO [] $ parseSrvHost <$> readProcessEnv "host" ["-t", "SRV", "--", srv] -- clear environment, to avoid LANG affecting output |