DNS fixes

3 files changed, 20 insertions, 15 deletions

diff --git a/Presence/DNSCache.hs b/Presence/DNSCache.hs
index 35493b19..854aa6c3 100644
--- a/Presence/DNSCache.hs
+++ b/Presence/DNSCache.hs
@@ -6,6 +6,7 @@ module DNSCache
     , newDNSCache
     , parseAddress
     , strip_brackets
+    , withPort
     ) where
 
 import Control.Concurrent
@@ -40,9 +41,8 @@ data DNSCache =
 
 newDNSCache :: IO DNSCache
 newDNSCache = do
-    atomically $ do
-        fcache <- newTVar Map.empty
-        rcache <- newTVar Map.empty
+        fcache <- newTVarIO Map.empty
+        rcache <- newTVarIO Map.empty
         return DNSCache { fcache=fcache, rcache=rcache }
 
 equivBy f a b = f a == f b
@@ -64,13 +64,14 @@ dnsObserve :: DNSCache -> Bool -> TimeStamp -> [(Text,SockAddr)] -> STM ()
 dnsObserve dns withScrub utc obs = do
     f <- readTVar $ fcache dns
     r <- readTVar $ rcache dns
-    let gs = do
-            g <- groupBy (equivBy fst) $ sortBy (comparing fst) obs
+    let obs' = map (\(n,a)->(n,a `withPort` 0)) obs
+        gs = do
+            g <- groupBy (equivBy fst) $ sortBy (comparing fst) obs'
             (n,_) <- take 1 g
             return (n,map snd g)
         f' = foldl' updatef f gs
         hs = do
-            h <- groupBy (equivBy snd) $ sortBy (comparing snd) obs
+            h <- groupBy (equivBy snd) $ sortBy (comparing snd) obs'
             (_,a) <- take 1 h
             return (a,map fst h)
         r' = foldl' updater r hs
@@ -206,3 +207,7 @@ parseAddress addr_str = do
                         (Just "0")
     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
+
diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index efd865d8..bfaaa751 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -76,10 +76,6 @@ import ControlMaybe
 import LockedChan
 import PeerResolve
 
-withPort :: SockAddr -> Int -> SockAddr
-withPort (SockAddrInet _ a)      port = SockAddrInet (toEnum port) a
-withPort (SockAddrInet6 _ a b c) port = SockAddrInet6 (toEnum port) a b c
-
 
 peerport :: PortNumber
 peerport = 5269
diff --git a/xmppServer.hs b/xmppServer.hs
index babde683..1dfb6496 100644
--- a/xmppServer.hs
+++ b/xmppServer.hs
@@ -163,6 +163,12 @@ chooseResourceName state k addr desired = do
                              , clientStatus = status
                              , clientFlags = flgs }
 
+    do -- forward-lookup of the buddies so that it is cached for reversing.
+       buds <- configText ConfigFiles.getBuddies (clientUser client)
+       forM_ buds $ \bud -> do
+            let (_,h,_) = splitJID bud
+            forkIO $ void $ resolvePeer h
+
     atomically $ do
         modifyTVar' (clients state) $ Map.insert k client
         modifyTVar' (clientsByUser state) $ flip Map.alter (clientUser client)
@@ -345,9 +351,6 @@ ip6literal addr = Text.map dash addr <> ".ipv6-literal.net"
     dash ':' = '-'
     dash x   = x
 
-withPort (SockAddrInet _ a)      port = SockAddrInet (toEnum port) a
-withPort (SockAddrInet6 _ a b c) port = SockAddrInet6 (toEnum port) a b c
-
 -- | The given address is taken to be the local address for the socket this JID
 -- came in on.  The returned JID parts are suitable for unsplitJID to create a
 -- valid JID for communicating to a client.  The returned Bool is True when the
@@ -370,7 +373,8 @@ peerKeyToResolvedName :: [Text] -> ConnectionKey -> IO Text
 peerKeyToResolvedName buds k@(ClientKey { localAddress=addr }) = return "ErrorClIeNt1"
 peerKeyToResolvedName buds pk = do
     ns <- peerKeyToResolvedNames pk
-    let ns' = sortBy (comparing $ not . flip elem buds) ns
+    let hs = map (\jid -> let (_,h,_)=splitJID jid in h) buds
+        ns' = sortBy (comparing $ not . flip elem hs) ns
     return $ maybe (peerKeyToText pk) id (listToMaybe ns')
 
 
@@ -447,7 +451,7 @@ deliverMessage state fail msg =
         buds <- configText ConfigFiles.getBuddies n
         from' <- do
             flip (maybe $ return Nothing) (stanzaFrom msg) $ \from -> do
-            (_,trip) <- rewriteJIDForClient laddr from [] -- XXX
+            (_,trip) <- rewriteJIDForClient laddr from buds
             return . Just $ unsplitJID trip
         let ks = Map.keys (networkClients presence_container)
             chans = mapMaybe (flip Map.lookup key_to_chan) ks