From a41ffe16f5f3237a0b16c49f743ba423b19e46d6 Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Thu, 6 Mar 2014 00:53:30 -0500
Subject: multiply presence for client (for hostname aliases)

---
 Presence/XMPPServer.hs | 15 +++++++++++----
 1 file changed, 11 insertions(+), 4 deletions(-)

(limited to 'Presence')

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
     , LangSpecificMessage(..)
     , peerKeyToText
     , peerKeyToResolvedName
+    , peerKeyToResolvedNames
     , addrToText
     , sendModifiedStanzaToPeer
     , sendModifiedStanzaToClient
@@ -50,6 +51,7 @@ import qualified Text.XML.Stream.Render as XML
 import qualified Text.XML.Stream.Parse as XML
 import Data.XML.Types as XML
 import Data.Maybe
+import Data.List (nub)
 import Data.Monoid ( (<>) )
 import Data.Text (Text)
 import qualified Data.Text as Text (pack,unpack)
@@ -227,12 +229,17 @@ peerKeyToText (ClientKey { localAddress=addr }) = "ErrorClIeNt0"
 
 peerKeyToResolvedName :: ConnectionKey -> IO Text
 peerKeyToResolvedName k@(ClientKey { localAddress=addr }) = return "ErrorClIeNt1"
-peerKeyToResolvedName k@(PeerKey { callBackAddress=addr }) = do
-    mname <- handleIO_ (return Nothing) $ do
+peerKeyToResolvedName pk = do
+    ns <- peerKeyToResolvedNames pk
+    return $ maybe (peerKeyToText pk) id (listToMaybe ns)
+
+peerKeyToResolvedNames :: ConnectionKey -> IO [Text]
+peerKeyToResolvedNames k@(ClientKey { localAddress=addr }) = return []
+peerKeyToResolvedNames k@(PeerKey { callBackAddress=addr }) = do
+    handleIO_ (return []) $ do
         ent <- getHostByAddr addr --  AF_UNSPEC addr
         let names = BSD.hostName ent : BSD.hostAliases ent
-        return $ listToMaybe names
-    return $ maybe (peerKeyToText k) Text.pack mname 
+        return $ map Text.pack $ nub names
 
 
 wlog :: String -> IO ()
-- 
cgit v1.2.3