summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--xmppServer.hs22
1 files changed, 20 insertions, 2 deletions
diff --git a/xmppServer.hs b/xmppServer.hs
index 11de871d..606bd05e 100644
--- a/xmppServer.hs
+++ b/xmppServer.hs
@@ -40,7 +40,10 @@ unsplitJID (n,h,r) = jid
40 jid0 = maybe h (\n->n<>"@"<>h) n 40 jid0 = maybe h (\n->n<>"@"<>h) n
41 jid = maybe jid0 (\r->jid0<>"/"<>r) r 41 jid = maybe jid0 (\r->jid0<>"/"<>r) r
42 42
43splitJID :: Text -> (Maybe Text,Text,Maybe Text) 43type UserName = Text
44type ResourceName = Text
45
46splitJID :: Text -> (Maybe UserName,Text,Maybe ResourceName)
44splitJID bjid = 47splitJID bjid =
45 let xs = splitAll '@' bjid 48 let xs = splitAll '@' bjid
46 ys = splitAll '/' (last xs) 49 ys = splitAll '/' (last xs)
@@ -56,6 +59,11 @@ splitJID bjid =
56 _ -> Nothing 59 _ -> Nothing
57 in (name,server,rsrc) 60 in (name,server,rsrc)
58 61
62isPeerKey :: ConnectionKey -> Bool
63isPeerKey k = case k of { PeerKey {} -> True ; _ -> False }
64
65isClientKey :: ConnectionKey -> Bool
66isClientKey k = case k of { ClientKey {} -> True ; _ -> False }
59 67
60textHostName = fmap Text.pack BSD.getHostName 68textHostName = fmap Text.pack BSD.getHostName
61 69
@@ -94,6 +102,9 @@ pcIsEmpty pc = Map.null (networkClients pc)
94data PresenceState = PresenceState 102data PresenceState = PresenceState
95 { clients :: TVar (Map ConnectionKey ClientState) 103 { clients :: TVar (Map ConnectionKey ClientState)
96 , clientsByUser :: TVar (Map Text PresenceContainer) 104 , clientsByUser :: TVar (Map Text PresenceContainer)
105 , remotesByPeer :: TVar (Map ConnectionKey
106 (Map UserName
107 (Map ResourceName ())))
97 , associatedPeers :: TVar (Map SockAddr ()) 108 , associatedPeers :: TVar (Map SockAddr ())
98 , server :: TMVar XMPPServer 109 , server :: TMVar XMPPServer
99 , keyToChan :: TVar (Map ConnectionKey Conn) 110 , keyToChan :: TVar (Map ConnectionKey Conn)
@@ -210,10 +221,15 @@ rosterGetSubscribers = rosterGetStuff ConfigFiles.getSubscribers
210data Conn = Conn { connChan :: TChan Stanza 221data Conn = Conn { connChan :: TChan Stanza
211 , auxAddr :: SockAddr } 222 , auxAddr :: SockAddr }
212 223
213newConn state k addr outchan = 224sendProbesAndSlocitations state k chan = do
225 return ()
226
227newConn state k addr outchan = do
214 atomically $ modifyTVar' (keyToChan state) 228 atomically $ modifyTVar' (keyToChan state)
215 $ Map.insert k Conn { connChan = outchan 229 $ Map.insert k Conn { connChan = outchan
216 , auxAddr = addr } 230 , auxAddr = addr }
231 when (isPeerKey k)
232 $ sendProbesAndSlocitations state k outchan
217 233
218eofConn state k = atomically $ modifyTVar' (keyToChan state) $ Map.delete k 234eofConn state k = atomically $ modifyTVar' (keyToChan state) $ Map.delete k
219 235
@@ -332,12 +348,14 @@ main = runResourceT $ do
332 state <- liftIO . atomically $ do 348 state <- liftIO . atomically $ do
333 clients <- newTVar Map.empty 349 clients <- newTVar Map.empty
334 clientsByUser <- newTVar Map.empty 350 clientsByUser <- newTVar Map.empty
351 remotesByPeer <- newTVar Map.empty
335 associatedPeers <- newTVar Map.empty 352 associatedPeers <- newTVar Map.empty
336 xmpp <- newEmptyTMVar 353 xmpp <- newEmptyTMVar
337 keyToChan <- newTVar Map.empty 354 keyToChan <- newTVar Map.empty
338 return PresenceState 355 return PresenceState
339 { clients = clients 356 { clients = clients
340 , clientsByUser = clientsByUser 357 , clientsByUser = clientsByUser
358 , remotesByPeer = remotesByPeer
341 , associatedPeers = associatedPeers 359 , associatedPeers = associatedPeers
342 , keyToChan = keyToChan 360 , keyToChan = keyToChan
343 , server = xmpp 361 , server = xmpp