diff options
Diffstat (limited to 'Presence')
-rw-r--r-- | Presence/XMPPServer.hs | 37 |
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 -} -> | |||
1435 | lookupService me mucs to = case Text.toLower to of | 1435 | lookupService 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 |