XMPP: Type-checking on various uses of SockAddr.

1 files changed, 21 insertions, 1 deletions

diff --git a/Presence/DNSCache.hs b/Presence/DNSCache.hs
index ce35752e..c5154e34 100644
--- a/Presence/DNSCache.hs
+++ b/Presence/DNSCache.hs
@@ -17,6 +17,7 @@ module DNSCache
     , forwardResolve
     , newDNSCache
     , parseAddress
+    , unsafeParseAddress
     , strip_brackets
     , withPort
     ) where
@@ -27,6 +28,7 @@ import Control.Concurrent.Lifted.Instrument
 import Control.Concurrent.Lifted
 import GHC.Conc                  (labelThread)
 #endif
+import Control.Arrow
 import Control.Concurrent.STM
 import Data.Text       ( Text )
 import Network.Socket  ( SockAddr(..), AddrInfoFlag(..), defaultHints, getAddrInfo, AddrInfo(..) )
@@ -44,6 +46,7 @@ import Data.List
 import Data.Ord
 import Data.Maybe
 import System.IO.Error
+import System.IO.Unsafe
 
 import SockAddr      ()
 import ControlMaybe  ( handleIO_ )
@@ -144,7 +147,7 @@ rawForwardResolve dns onFail timeout addrtext = do
       return ()
 
 strip_brackets :: Text -> Text
-strip_brackets s = 
+strip_brackets s =
       case Text.uncons s of
           Just ('[',t) -> Text.takeWhile (/=']') t
           _            -> s
@@ -265,6 +268,23 @@ parseAddress addr_str = do
     return . listToMaybe $ map addrAddress info
 
 
+splitAtPort :: String -> (String,String)
+splitAtPort s = second sanitizePort $ case s of
+    ('[':t) -> break (==']') t
+    _       -> break (==':') s
+ where
+    sanitizePort (']':':':p) = p
+    sanitizePort (':':p)     = p
+    sanitizePort _           = "0"
+
+unsafeParseAddress :: String -> Maybe SockAddr
+unsafeParseAddress addr_str = unsafePerformIO $ do
+    let (ipstr,portstr) = splitAtPort addr_str
+    info <- getAddrInfo (Just $ defaultHints { addrFlags = [ AI_NUMERICHOST ] })
+                        (Just ipstr)
+                        (Just portstr)
+    return . listToMaybe $ map addrAddress info
+
 withPort :: SockAddr -> Int -> SockAddr
 withPort (SockAddrInet _ a)      port = SockAddrInet (toEnum port) a
 withPort (SockAddrInet6 _ a b c) port = SockAddrInet6 (toEnum port) a b c