Threaded dns...

1 files changed, 7 insertions, 1 deletions

diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index aae5e97a..f029810d 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -68,6 +68,7 @@ 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 qualified Control.Concurrent.STM.UpdateStream as Slotted
@@ -254,10 +255,15 @@ peerKeyToResolvedNames :: ConnectionKey -> IO [Text]
 peerKeyToResolvedNames k@(ClientKey { localAddress=addr }) = return []
 peerKeyToResolvedNames k@(PeerKey { callBackAddress=addr }) = do
     handleIO_ (return []) $ do
-        ent <- getHostByAddr addr --  AF_UNSPEC addr
+        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