summaryrefslogtreecommitdiff
path: root/xmppServer.hs
diff options
context:
space:
mode:
Diffstat (limited to 'xmppServer.hs')
-rw-r--r--xmppServer.hs14
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
348withPort (SockAddrInet _ a) port = SockAddrInet (toEnum port) a
349withPort (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
370peerKeyToResolvedName buds k@(ClientKey { localAddress=addr }) = return "ErrorClIeNt1" 373peerKeyToResolvedName buds k@(ClientKey { localAddress=addr }) = return "ErrorClIeNt1"
371peerKeyToResolvedName buds pk = do 374peerKeyToResolvedName 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