From f92276b3c28e715146bee11d0cdb48b711190fea Mon Sep 17 00:00:00 2001 From: joe Date: Tue, 11 Mar 2014 00:34:28 -0400 Subject: DNS fixes --- xmppServer.hs | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) (limited to 'xmppServer.hs') 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 -- cgit v1.2.3