summaryrefslogtreecommitdiff
path: root/Presence/XMPPServer.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Presence/XMPPServer.hs')
-rw-r--r--Presence/XMPPServer.hs21
1 files changed, 16 insertions, 5 deletions
diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index 1de6a26a..49cfbb95 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -1254,8 +1254,9 @@ forkConnection :: Server SockAddr ConnectionData releaseKey XML.Event
1254 -> Sink (Flush XML.Event) IO () 1254 -> Sink (Flush XML.Event) IO ()
1255 -> TChan Stanza 1255 -> TChan Stanza
1256 -> IO (TChan Stanza) 1256 -> IO (TChan Stanza)
1257forkConnection sv xmpp saddr (ConnectionData auxAddr _) pingflag src snk stanzas = do 1257forkConnection sv xmpp saddr cdta pingflag src snk stanzas = do
1258 let clientOrServer@(namespace,tellmyname,telltheirname,_) = case auxAddr of 1258 let auxAddr = cdAddr cdta
1259 clientOrServer@(namespace,tellmyname,telltheirname,_) = case auxAddr of
1259 Right _ -> ("jabber:client", xmppTellMyNameToClient xmpp (ClientAddress saddr) 1260 Right _ -> ("jabber:client", xmppTellMyNameToClient xmpp (ClientAddress saddr)
1260 , xmppTellClientHisName xmpp (ClientAddress saddr) 1261 , xmppTellClientHisName xmpp (ClientAddress saddr)
1261 , ClientOrigin (ClientAddress saddr)) 1262 , ClientOrigin (ClientAddress saddr))
@@ -1414,13 +1415,19 @@ peerKey bind_addr sock = do
1414 else return laddr -- Weird hack: addr is would-be peer name 1415 else return laddr -- Weird hack: addr is would-be peer name
1415 -- Assume remote peers are listening on the same port that we do. 1416 -- Assume remote peers are listening on the same port that we do.
1416 let peerport = fromIntegral $ fromMaybe 5269 $ bind_addr >>= sockAddrPort 1417 let peerport = fromIntegral $ fromMaybe 5269 $ bind_addr >>= sockAddrPort
1417 return $ (raddr `withPort` peerport,ConnectionData (Left (Local laddr)) XMPP) 1418 return $ ( raddr `withPort` peerport
1419 , ConnectionData { cdAddr = Left (Local laddr)
1420 , cdType = XMPP
1421 , cdProfile = "." } )
1418 1422
1419clientKey :: SocketLike sock => sock -> IO (SockAddr,ConnectionData) 1423clientKey :: SocketLike sock => sock -> IO (SockAddr,ConnectionData)
1420clientKey sock = do 1424clientKey sock = do
1421 laddr <- getSocketName sock 1425 laddr <- getSocketName sock
1422 raddr <- getPeerName sock 1426 raddr <- getPeerName sock
1423 return $ (laddr,ConnectionData (Right (Remote raddr)) XMPP) 1427 return $ ( laddr
1428 , ConnectionData { cdAddr = Right (Remote raddr)
1429 , cdType = XMPP
1430 , cdProfile = "." } )
1424 1431
1425xmlifyRosterItems :: Monad m => Set Text -> Text -> Set Text -> ConduitM i Event m () 1432xmlifyRosterItems :: Monad m => Set Text -> Text -> Set Text -> ConduitM i Event m ()
1426xmlifyRosterItems solicited stype set = mapM_ item (Set.toList set) 1433xmlifyRosterItems solicited stype set = mapM_ item (Set.toList set)
@@ -1830,7 +1837,11 @@ data ConnectionType = XMPP | Tox
1830data ConnectionData = ConnectionData 1837data ConnectionData = ConnectionData
1831 { cdAddr :: Either (Local SockAddr) -- Peer connection local address 1838 { cdAddr :: Either (Local SockAddr) -- Peer connection local address
1832 (Remote SockAddr) -- Client connection remote address 1839 (Remote SockAddr) -- Client connection remote address
1833 , cdType :: ConnectionType 1840 , cdType :: ConnectionType
1841 , cdProfile :: Text -- Currently ignored for clients. Instead, see
1842 -- 'clientProfile' field of 'ClientState'.
1843 --
1844 -- For peers: "." for XMPP, otherwise the ".tox" hostname.
1834 } 1845 }
1835 deriving (Eq,Ord,Show) 1846 deriving (Eq,Ord,Show)
1836 1847