diff options
Diffstat (limited to 'xmppServer.hs')
-rw-r--r-- | xmppServer.hs | 14 |
1 files changed, 9 insertions, 5 deletions
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 | |||
163 | , clientStatus = status | 163 | , clientStatus = status |
164 | , clientFlags = flgs } | 164 | , clientFlags = flgs } |
165 | 165 | ||
166 | do -- forward-lookup of the buddies so that it is cached for reversing. | ||
167 | buds <- configText ConfigFiles.getBuddies (clientUser client) | ||
168 | forM_ buds $ \bud -> do | ||
169 | let (_,h,_) = splitJID bud | ||
170 | forkIO $ void $ resolvePeer h | ||
171 | |||
166 | atomically $ do | 172 | atomically $ do |
167 | modifyTVar' (clients state) $ Map.insert k client | 173 | modifyTVar' (clients state) $ Map.insert k client |
168 | modifyTVar' (clientsByUser state) $ flip Map.alter (clientUser client) | 174 | modifyTVar' (clientsByUser state) $ flip Map.alter (clientUser client) |
@@ -345,9 +351,6 @@ ip6literal addr = Text.map dash addr <> ".ipv6-literal.net" | |||
345 | dash ':' = '-' | 351 | dash ':' = '-' |
346 | dash x = x | 352 | dash x = x |
347 | 353 | ||
348 | withPort (SockAddrInet _ a) port = SockAddrInet (toEnum port) a | ||
349 | withPort (SockAddrInet6 _ a b c) port = SockAddrInet6 (toEnum port) a b c | ||
350 | |||
351 | -- | The given address is taken to be the local address for the socket this JID | 354 | -- | The given address is taken to be the local address for the socket this JID |
352 | -- came in on. The returned JID parts are suitable for unsplitJID to create a | 355 | -- came in on. The returned JID parts are suitable for unsplitJID to create a |
353 | -- valid JID for communicating to a client. The returned Bool is True when the | 356 | -- valid JID for communicating to a client. The returned Bool is True when the |
@@ -370,7 +373,8 @@ peerKeyToResolvedName :: [Text] -> ConnectionKey -> IO Text | |||
370 | peerKeyToResolvedName buds k@(ClientKey { localAddress=addr }) = return "ErrorClIeNt1" | 373 | peerKeyToResolvedName buds k@(ClientKey { localAddress=addr }) = return "ErrorClIeNt1" |
371 | peerKeyToResolvedName buds pk = do | 374 | peerKeyToResolvedName buds pk = do |
372 | ns <- peerKeyToResolvedNames pk | 375 | ns <- peerKeyToResolvedNames pk |
373 | let ns' = sortBy (comparing $ not . flip elem buds) ns | 376 | let hs = map (\jid -> let (_,h,_)=splitJID jid in h) buds |
377 | ns' = sortBy (comparing $ not . flip elem hs) ns | ||
374 | return $ maybe (peerKeyToText pk) id (listToMaybe ns') | 378 | return $ maybe (peerKeyToText pk) id (listToMaybe ns') |
375 | 379 | ||
376 | 380 | ||
@@ -447,7 +451,7 @@ deliverMessage state fail msg = | |||
447 | buds <- configText ConfigFiles.getBuddies n | 451 | buds <- configText ConfigFiles.getBuddies n |
448 | from' <- do | 452 | from' <- do |
449 | flip (maybe $ return Nothing) (stanzaFrom msg) $ \from -> do | 453 | flip (maybe $ return Nothing) (stanzaFrom msg) $ \from -> do |
450 | (_,trip) <- rewriteJIDForClient laddr from [] -- XXX | 454 | (_,trip) <- rewriteJIDForClient laddr from buds |
451 | return . Just $ unsplitJID trip | 455 | return . Just $ unsplitJID trip |
452 | let ks = Map.keys (networkClients presence_container) | 456 | let ks = Map.keys (networkClients presence_container) |
453 | chans = mapMaybe (flip Map.lookup key_to_chan) ks | 457 | chans = mapMaybe (flip Map.lookup key_to_chan) ks |