4 files changed, 18 insertions, 77 deletions

diff --git a/Presence/Server.hs b/Presence/Server.hs
index abf9f5e3..fd5f1e43 100644
--- a/Presence/Server.hs
+++ b/Presence/Server.hs
@@ -63,16 +63,11 @@ import Network.BSD
 import Debug.Trace
 import Data.Time.Clock (UTCTime,getCurrentTime,diffUTCTime)
 import Data.Time.Format (formatTime)
+import SockAddr ()
 -- import System.Locale (defaultTimeLocale)
 
 todo = error "unimplemented"
 
-#if MIN_VERSION_network(2,4,0)
-#else
-deriving instance Ord SockAddr
-#endif
-
-
 type Microseconds = Int
 type Miliseconds = Int
 type TimeOut = Miliseconds
diff --git a/Presence/SockAddr.hs b/Presence/SockAddr.hs
new file mode 100644
index 00000000..91a03870
--- /dev/null
+++ b/Presence/SockAddr.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE StandaloneDeriving #-}
+module SockAddr () where
+
+import Network.Socket ( SockAddr(..) )
+
+#if MIN_VERSION_network(2,4,0)
+#else
+deriving instance Ord SockAddr
+#endif
+
+
+
diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index f029810d..9059a4c0 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -66,17 +66,17 @@ import qualified Data.Map as Map
 import Data.Set (Set, (\\) )
 import qualified Data.Set as Set
 import qualified System.Random 
-import qualified Network.BSD as BSD
 import Data.Void (Void)
 import System.Endian (toBE32)
 
-import GetHostByAddr (getHostByAddr)
+import ConnectionKey
 import qualified Control.Concurrent.STM.UpdateStream as Slotted
 import Nesting
 import Server
 import EventUtil
 import ControlMaybe
 import LockedChan
+import PeerResolve
 
 withPort :: SockAddr -> Int -> SockAddr
 withPort (SockAddrInet _ a)      port = SockAddrInet (toEnum port) a
@@ -91,11 +91,6 @@ clientport = 5222
 my_uuid :: Text
 my_uuid = "154ae29f-98f2-4af4-826d-a40c8a188574"
 
-data ConnectionKey
-       = PeerKey { callBackAddress :: SockAddr }
-       | ClientKey { localAddress :: SockAddr }
- deriving (Show, Ord, Eq)
-
 data JabberShow = Offline
                 | ExtendedAway
                 | Away
@@ -251,19 +246,6 @@ peerKeyToResolvedName pk = do
     ns <- peerKeyToResolvedNames pk
     return $ maybe (peerKeyToText pk) id (listToMaybe ns)
 
-peerKeyToResolvedNames :: ConnectionKey -> IO [Text]
-peerKeyToResolvedNames k@(ClientKey { localAddress=addr }) = return []
-peerKeyToResolvedNames k@(PeerKey { callBackAddress=addr }) = do
-    handleIO_ (return []) $ do
-        ent <- getHostByAddr (unmap6mapped4 addr) --  AF_UNSPEC addr
-        let names = BSD.hostName ent : BSD.hostAliases ent
-        return $ map Text.pack $ nub names
-
-unmap6mapped4 addr@(SockAddrInet6 port _ (0,0,0xFFFF,a) _) =
-    SockAddrInet port (toBE32 a)
-unmap6mapped4 addr = addr
-
-
 
 wlog :: String -> IO ()
 wlog s = putStrLn s >> hFlush stdout
diff --git a/xmppServer.hs b/xmppServer.hs
index 3752218a..f7f7fb36 100644
--- a/xmppServer.hs
+++ b/xmppServer.hs
@@ -7,14 +7,7 @@ import Control.Concurrent.STM.TMVar
 import Control.Monad.Trans.Resource (runResourceT)
 import Control.Monad.Trans
 import Control.Monad.IO.Class (MonadIO, liftIO)
-import Network.Socket
-    ( addrAddress
-    , getAddrInfo
-    , defaultHints
-    , addrFlags
-    , AddrInfoFlag(AI_CANONNAME,AI_V4MAPPED,AI_NUMERICHOST)
-    , SockAddr(..)
-    )
+import Network.Socket ( SockAddr(..) )
 import System.Endian (fromBE32)
 import Data.List (nub, (\\), intersect, groupBy, sort )
 import Data.Monoid ( (<>) )
@@ -40,6 +33,7 @@ import TraversableT
 import UTmp (ProcessID,users)
 import LocalPeerCred
 import XMPPServer
+import PeerResolve
 
 type UserName = Text
 type ResourceName = Text
@@ -142,42 +136,6 @@ data PresenceState = PresenceState
     }
 
 
-make6mapped4 addr@(SockAddrInet6 {}) = addr
-make6mapped4 addr@(SockAddrInet port a) = SockAddrInet6 port 0 (0,0,0xFFFF,fromBE32 a) 0
-
-resolvePeer :: Text -> IO [SockAddr]
-resolvePeer addrtext = do
-    r <- atomically newEmptyTMVar
-    mvar <- atomically newEmptyTMVar
-    rt <- forkOS $ resolver r mvar
-    tt <- forkIO $ timer r rt
-    atomically $ putTMVar mvar tt
-    atomically $ readTMVar r
- where
-    resolver r mvar = do
-      xs <- handle (\e -> let _ = isDoesNotExistError e in return [])
-            $ do fmap (map $ make6mapped4 . addrAddress) $ 
-                  getAddrInfo (Just $ defaultHints { addrFlags = [ AI_CANONNAME, AI_V4MAPPED ]})
-                    (Just $ Text.unpack $ strip_brackets addrtext)
-                    (Just "5269")
-      did <- atomically $ tryPutTMVar r xs
-      when did $ do
-      tt <- atomically $ readTMVar mvar
-      throwTo tt (ErrorCall "Interrupted delay")
-      return ()
-    timer r rt = do
-      handle (\(ErrorCall _)-> return ()) $ do
-      threadDelay 1000000
-      did <- atomically $ tryPutTMVar r []
-      when did $ do
-      putStrLn $ "timeout resolving: "++show addrtext
-      killThread rt
-
-strip_brackets s = 
-    case Text.uncons s of
-      Just ('[',t) -> Text.takeWhile (/=']') t
-      _            -> s
-
 
 getConsolePids :: PresenceState -> IO [(Text,ProcessID)]
 getConsolePids state = do
@@ -376,13 +334,6 @@ rewriteJIDForClient1 jid = do
         return $ Just ((n,h',r), addr)
 -}
 
-parseAddress :: Text -> IO (Maybe SockAddr)
-parseAddress addr_str = do
-    info <- getAddrInfo (Just $ defaultHints { addrFlags = [ AI_NUMERICHOST ] }) 
-                        (Just . Text.unpack $ addr_str) 
-                        (Just "0")
-    return . listToMaybe $ map addrAddress info
-
 todo = error "Unimplemented"