diff options
Diffstat (limited to 'Presence/XMPPServer.hs')
-rw-r--r-- | Presence/XMPPServer.hs | 15 |
1 files changed, 11 insertions, 4 deletions
diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs index dd693b8c..af392f27 100644 --- a/Presence/XMPPServer.hs +++ b/Presence/XMPPServer.hs | |||
@@ -16,6 +16,7 @@ module XMPPServer | |||
16 | , LangSpecificMessage(..) | 16 | , LangSpecificMessage(..) |
17 | , peerKeyToText | 17 | , peerKeyToText |
18 | , peerKeyToResolvedName | 18 | , peerKeyToResolvedName |
19 | , peerKeyToResolvedNames | ||
19 | , addrToText | 20 | , addrToText |
20 | , sendModifiedStanzaToPeer | 21 | , sendModifiedStanzaToPeer |
21 | , sendModifiedStanzaToClient | 22 | , sendModifiedStanzaToClient |
@@ -50,6 +51,7 @@ import qualified Text.XML.Stream.Render as XML | |||
50 | import qualified Text.XML.Stream.Parse as XML | 51 | import qualified Text.XML.Stream.Parse as XML |
51 | import Data.XML.Types as XML | 52 | import Data.XML.Types as XML |
52 | import Data.Maybe | 53 | import Data.Maybe |
54 | import Data.List (nub) | ||
53 | import Data.Monoid ( (<>) ) | 55 | import Data.Monoid ( (<>) ) |
54 | import Data.Text (Text) | 56 | import Data.Text (Text) |
55 | import qualified Data.Text as Text (pack,unpack) | 57 | import qualified Data.Text as Text (pack,unpack) |
@@ -227,12 +229,17 @@ peerKeyToText (ClientKey { localAddress=addr }) = "ErrorClIeNt0" | |||
227 | 229 | ||
228 | peerKeyToResolvedName :: ConnectionKey -> IO Text | 230 | peerKeyToResolvedName :: ConnectionKey -> IO Text |
229 | peerKeyToResolvedName k@(ClientKey { localAddress=addr }) = return "ErrorClIeNt1" | 231 | peerKeyToResolvedName k@(ClientKey { localAddress=addr }) = return "ErrorClIeNt1" |
230 | peerKeyToResolvedName k@(PeerKey { callBackAddress=addr }) = do | 232 | peerKeyToResolvedName pk = do |
231 | mname <- handleIO_ (return Nothing) $ do | 233 | ns <- peerKeyToResolvedNames pk |
234 | return $ maybe (peerKeyToText pk) id (listToMaybe ns) | ||
235 | |||
236 | peerKeyToResolvedNames :: ConnectionKey -> IO [Text] | ||
237 | peerKeyToResolvedNames k@(ClientKey { localAddress=addr }) = return [] | ||
238 | peerKeyToResolvedNames k@(PeerKey { callBackAddress=addr }) = do | ||
239 | handleIO_ (return []) $ do | ||
232 | ent <- getHostByAddr addr -- AF_UNSPEC addr | 240 | ent <- getHostByAddr addr -- AF_UNSPEC addr |
233 | let names = BSD.hostName ent : BSD.hostAliases ent | 241 | let names = BSD.hostName ent : BSD.hostAliases ent |
234 | return $ listToMaybe names | 242 | return $ map Text.pack $ nub names |
235 | return $ maybe (peerKeyToText k) Text.pack mname | ||
236 | 243 | ||
237 | 244 | ||
238 | wlog :: String -> IO () | 245 | wlog :: String -> IO () |