diff options
Diffstat (limited to 'Presence/XMPPServer.hs')
-rw-r--r-- | Presence/XMPPServer.hs | 21 |
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) |
1257 | forkConnection sv xmpp saddr (ConnectionData auxAddr _) pingflag src snk stanzas = do | 1257 | forkConnection 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 | ||
1419 | clientKey :: SocketLike sock => sock -> IO (SockAddr,ConnectionData) | 1423 | clientKey :: SocketLike sock => sock -> IO (SockAddr,ConnectionData) |
1420 | clientKey sock = do | 1424 | clientKey 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 | ||
1425 | xmlifyRosterItems :: Monad m => Set Text -> Text -> Set Text -> ConduitM i Event m () | 1432 | xmlifyRosterItems :: Monad m => Set Text -> Text -> Set Text -> ConduitM i Event m () |
1426 | xmlifyRosterItems solicited stype set = mapM_ item (Set.toList set) | 1433 | xmlifyRosterItems solicited stype set = mapM_ item (Set.toList set) |
@@ -1830,7 +1837,11 @@ data ConnectionType = XMPP | Tox | |||
1830 | data ConnectionData = ConnectionData | 1837 | data 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 | ||