From b6f84bd5bca03a5493c038c3e9bb26892224a41a Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Mon, 26 Nov 2018 00:00:28 -0500
Subject: MUC: More flexible groupchat room-id.  Allow all non-"unavailable"
 joins.

---
 Presence/XMPPServer.hs | 37 +++++++++++++++++--------------------
 1 file changed, 17 insertions(+), 20 deletions(-)

(limited to 'Presence/XMPPServer.hs')

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 -} ->
 lookupService me mucs to = case Text.toLower to of
     nm | nm == Text.toLower me
          -> TopLevelService
-    nm | let (a0,b) = Text.break (=='.') nm
+    nm | let (a,hostname) = second (Text.drop 1) $ Text.break (=='@') nm
+             (service,b)  = Text.break (=='.') $ if Text.null hostname then a else hostname
        , Text.drop 1 b == Text.toLower me
-       , let (a,service) = second (Text.drop 1) $ Text.break (=='@') a0
-         -> if Text.null service -- No '@' means that variable /a/ is the service.
-                then case Map.lookup a mucs of
-                    Just muc -> Service Nothing a muc
-                    Nothing  -> UnknownService a -- ItemNotFound
-                else case Map.lookup service mucs of
-                    Just muc -> Service (Just a) service muc
+         -> case Map.lookup service mucs of
+                    Just muc -> Service (if Text.null hostname then Nothing else Just a) service muc
                     Nothing  -> UnknownService service
     _ -> NotMe
 
@@ -1514,18 +1510,6 @@ applyStanza sv joined_rooms quitVar xmpp stanza = do
                                     [ ("by", [ContentText roomjid]) ]
                                 sendReply quitVar (Error JidMalformed (head reply)) reply replyto
                             Just nick -> case presenceShow (stanzaType stanza) of
-                                Available -> do
-                                    jid <- xmppTellClientHisName xmpp k
-                                    join $ atomically $ do
-                                    jrs <- readTVar joined_rooms
-                                    let m = Map.findWithDefault Map.empty k jrs
-                                    case Map.lookup (room,mucname) m of
-                                        Nothing -> do r <- mucJoinRoom muc jid nick room k -- stanza
-                                                      jrs <- readTVar joined_rooms
-                                                      let m = Map.findWithDefault Map.empty k jrs
-                                                      writeTVar joined_rooms $ Map.insert k (Map.insert (room,mucname) (replyto,r) m) jrs
-                                                      return $ return ()
-                                        Just r -> return $ dput XJabber "MUC: already joined."
                                 Offline   -> do
                                     jid <- xmppTellClientHisName xmpp k
                                     atomically $ do
@@ -1541,6 +1525,19 @@ applyStanza sv joined_rooms quitVar xmpp stanza = do
                                                 writeTVar joined_rooms jrs'
                                                 -}
                                             _          -> return ()
+                                -- Anything other than type="unavailable" is treated as a join.
+                                _ -> do
+                                    jid <- xmppTellClientHisName xmpp k
+                                    join $ atomically $ do
+                                    jrs <- readTVar joined_rooms
+                                    let m = Map.findWithDefault Map.empty k jrs
+                                    case Map.lookup (room,mucname) m of
+                                        Nothing -> do r <- mucJoinRoom muc jid nick room k -- stanza
+                                                      jrs <- readTVar joined_rooms
+                                                      let m = Map.findWithDefault Map.empty k jrs
+                                                      writeTVar joined_rooms $ Map.insert k (Map.insert (room,mucname) (replyto,r) m) jrs
+                                                      return $ return ()
+                                        Just r -> return $ dput XJabber "MUC: already joined."
                    | otherwise -> do
                         -- Handle presence stanza that is not a chatroom join.
                         xmppInformClientPresence xmpp k stanza
-- 
cgit v1.2.3