summaryrefslogtreecommitdiff
path: root/Presence/XMPPServer.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Presence/XMPPServer.hs')
-rw-r--r--Presence/XMPPServer.hs37
1 files changed, 17 insertions, 20 deletions
diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index d26e8c03..fe099fb8 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -1435,15 +1435,11 @@ lookupService :: Text {- ^ hostname -} -> Map.Map Text a {- ^ service map -} ->
1435lookupService me mucs to = case Text.toLower to of 1435lookupService me mucs to = case Text.toLower to of
1436 nm | nm == Text.toLower me 1436 nm | nm == Text.toLower me
1437 -> TopLevelService 1437 -> TopLevelService
1438 nm | let (a0,b) = Text.break (=='.') nm 1438 nm | let (a,hostname) = second (Text.drop 1) $ Text.break (=='@') nm
1439 (service,b) = Text.break (=='.') $ if Text.null hostname then a else hostname
1439 , Text.drop 1 b == Text.toLower me 1440 , Text.drop 1 b == Text.toLower me
1440 , let (a,service) = second (Text.drop 1) $ Text.break (=='@') a0 1441 -> case Map.lookup service mucs of
1441 -> if Text.null service -- No '@' means that variable /a/ is the service. 1442 Just muc -> Service (if Text.null hostname then Nothing else Just a) service muc
1442 then case Map.lookup a mucs of
1443 Just muc -> Service Nothing a muc
1444 Nothing -> UnknownService a -- ItemNotFound
1445 else case Map.lookup service mucs of
1446 Just muc -> Service (Just a) service muc
1447 Nothing -> UnknownService service 1443 Nothing -> UnknownService service
1448 _ -> NotMe 1444 _ -> NotMe
1449 1445
@@ -1514,18 +1510,6 @@ applyStanza sv joined_rooms quitVar xmpp stanza = do
1514 [ ("by", [ContentText roomjid]) ] 1510 [ ("by", [ContentText roomjid]) ]
1515 sendReply quitVar (Error JidMalformed (head reply)) reply replyto 1511 sendReply quitVar (Error JidMalformed (head reply)) reply replyto
1516 Just nick -> case presenceShow (stanzaType stanza) of 1512 Just nick -> case presenceShow (stanzaType stanza) of
1517 Available -> do
1518 jid <- xmppTellClientHisName xmpp k
1519 join $ atomically $ do
1520 jrs <- readTVar joined_rooms
1521 let m = Map.findWithDefault Map.empty k jrs
1522 case Map.lookup (room,mucname) m of
1523 Nothing -> do r <- mucJoinRoom muc jid nick room k -- stanza
1524 jrs <- readTVar joined_rooms
1525 let m = Map.findWithDefault Map.empty k jrs
1526 writeTVar joined_rooms $ Map.insert k (Map.insert (room,mucname) (replyto,r) m) jrs
1527 return $ return ()
1528 Just r -> return $ dput XJabber "MUC: already joined."
1529 Offline -> do 1513 Offline -> do
1530 jid <- xmppTellClientHisName xmpp k 1514 jid <- xmppTellClientHisName xmpp k
1531 atomically $ do 1515 atomically $ do
@@ -1541,6 +1525,19 @@ applyStanza sv joined_rooms quitVar xmpp stanza = do
1541 writeTVar joined_rooms jrs' 1525 writeTVar joined_rooms jrs'
1542 -} 1526 -}
1543 _ -> return () 1527 _ -> return ()
1528 -- Anything other than type="unavailable" is treated as a join.
1529 _ -> do
1530 jid <- xmppTellClientHisName xmpp k
1531 join $ atomically $ do
1532 jrs <- readTVar joined_rooms
1533 let m = Map.findWithDefault Map.empty k jrs
1534 case Map.lookup (room,mucname) m of
1535 Nothing -> do r <- mucJoinRoom muc jid nick room k -- stanza
1536 jrs <- readTVar joined_rooms
1537 let m = Map.findWithDefault Map.empty k jrs
1538 writeTVar joined_rooms $ Map.insert k (Map.insert (room,mucname) (replyto,r) m) jrs
1539 return $ return ()
1540 Just r -> return $ dput XJabber "MUC: already joined."
1544 | otherwise -> do 1541 | otherwise -> do
1545 -- Handle presence stanza that is not a chatroom join. 1542 -- Handle presence stanza that is not a chatroom join.
1546 xmppInformClientPresence xmpp k stanza 1543 xmppInformClientPresence xmpp k stanza