From 79929b5a98a249a5175ba70c9674d458f31d245a Mon Sep 17 00:00:00 2001 From: joe Date: Sat, 13 Jul 2013 14:56:42 -0400 Subject: more comments in main.hs --- Presence/main.hs | 166 +++++++++++++++++++++++++++++++++---------------------- 1 file changed, 100 insertions(+), 66 deletions(-) diff --git a/Presence/main.hs b/Presence/main.hs index cfc7154c..86dfdacc 100644 --- a/Presence/main.hs +++ b/Presence/main.hs @@ -117,66 +117,32 @@ newPresenceState hostname = atomically $ do return $ PresenceState hostname tty us subs locals_greedy rchan remotes server_connections +{- ClientSessions + - + - This is the per-client state. It is manipulated mainly via the + - JabberClientSession interface. + -} data ClientSession = ClientSession { - localhost :: Peer, -- ByteString, + localhost :: Peer, -- anotehr name or the LocalHost constructor, todo: remove this. + + -- unix_uid: This is the detected uid of the user of the connecting client. + -- The ByteString is the numeric inode text parsed from /proc/net/tcp6 + -- (*not* the login name of the user) unix_uid :: (IORef (Maybe (UserID,L.ByteString))), + + -- unix_resource: This is the detected TTY of the connecting client. unix_resource :: (IORef (Maybe L.ByteString)), + + -- chans: This is a list of channels that the session is reading and will be + -- whose counts will be decremented when the session ends. + -- Note: currently is likely to be only two channels, the + -- localSubscriber & rosterChannel of the global state record. chans :: TVar [RefCountedChan], + + -- presence_state: a reference to the global state. presence_state :: PresenceState } -type RefCount = Int - -type JabberResource = L.ByteString -type JabberName = L.ByteString -data JabberUser = JabberUser JabberName Peer - deriving (Eq,Ord,Show) - -splitResource :: JID -> Maybe (JabberUser,Maybe JabberResource) -splitResource (JID Nothing _ _ ) = Nothing -splitResource (JID (Just n) p r ) = Just (JabberUser n p, r) - -unsplitResource (JabberUser n p) r = JID (Just n) p r - - -rosterPush msg state = do - let rchan = rosterChannel state - atomically $ do - isempty <- isEmptyTMVar rchan - when (not isempty) $ do - (_,ch) <- readTMVar rchan - writeTChan ch msg - -getJabberUserForId muid = - maybe (return "nobody") - (\(uid,_) -> - handle (\(SomeException _) -> - return . L.append "uid." . L.pack . show $ uid) - $ do - user <- fmap userName $ getUserEntryForID uid - return (L.pack user) - ) - muid - -cmpJID newitem jid = do - -- putStrLn $ "Comparing "<++>bshow jid - olditem <- parseHostNameJID jid - if olditem==newitem then return Nothing - else return $ Just jid - - -addRawJid modify user jid = do - newitem <- parseHostNameJID jid - modify user (cmpJID newitem) (Just jid) - return () - -addJid modify user jid = do - hjid <- asHostNameJID jid - putStrLn $ "addJid (asHostNameJID) --> "<++>bshow hjid - withJust hjid $ \hjid -> do - modify user (cmpJID jid) (Just hjid) - return () - instance JabberClientSession ClientSession where data XMPPClass ClientSession = ClientSessions PresenceState @@ -374,25 +340,25 @@ instance JabberClientSession ClientSession where (peer cjid) return () -tupleToJID (user,tty,pid) = jid user LocalHost tty - -getUserStatus state user = do - (tty,users) <- atomically $ do - tty <- readTVar $ currentTTY state - users <- readTVar $ activeUsers state - return (tty,users) - let jids = Set.filter (\(name,tty,pid) -> name ==user) users - ps = map (\jid -> Presence (tupleToJID jid) (matchResource' tty jid)) . Set.toList $ jids - if null ps - then return [Presence (JID { name=Just user, peer=LocalHost, resource=Nothing }) Offline] - else return ps - +{- PeerSession + - + - This is the per-remote-peer state. It is manipulated mainly via the + - JabberPeerSession interface. + -} data PeerSession = PeerSession { + -- announced: a list of users that were announced by the remote peer. + -- This list is kept in order to mark them all offline in + -- case the peer connection is lost or goes down. announced :: TVar (MultiMap JabberUser (JabberResource,JabberShow)), + + -- peer_name: This the address of the remote peer. peer_name :: Peer, + + -- peer_global: a reference to the global state. peer_global :: PresenceState } + instance JabberPeerSession PeerSession where data XMPPPeerClass PeerSession = PeerSessions PresenceState @@ -486,6 +452,74 @@ instance JabberPeerSession PeerSession where rosterPush (PendingSubscriber user buddy) (peer_global session) + +type RefCount = Int + +type JabberResource = L.ByteString +type JabberName = L.ByteString +data JabberUser = JabberUser JabberName Peer + deriving (Eq,Ord,Show) + +splitResource :: JID -> Maybe (JabberUser,Maybe JabberResource) +splitResource (JID Nothing _ _ ) = Nothing +splitResource (JID (Just n) p r ) = Just (JabberUser n p, r) + +unsplitResource (JabberUser n p) r = JID (Just n) p r + + +rosterPush msg state = do + let rchan = rosterChannel state + atomically $ do + isempty <- isEmptyTMVar rchan + when (not isempty) $ do + (_,ch) <- readTMVar rchan + writeTChan ch msg + +getJabberUserForId muid = + maybe (return "nobody") + (\(uid,_) -> + handle (\(SomeException _) -> + return . L.append "uid." . L.pack . show $ uid) + $ do + user <- fmap userName $ getUserEntryForID uid + return (L.pack user) + ) + muid + +cmpJID newitem jid = do + -- putStrLn $ "Comparing "<++>bshow jid + olditem <- parseHostNameJID jid + if olditem==newitem then return Nothing + else return $ Just jid + + +addRawJid modify user jid = do + newitem <- parseHostNameJID jid + modify user (cmpJID newitem) (Just jid) + return () + +addJid modify user jid = do + hjid <- asHostNameJID jid + putStrLn $ "addJid (asHostNameJID) --> "<++>bshow hjid + withJust hjid $ \hjid -> do + modify user (cmpJID jid) (Just hjid) + return () + +tupleToJID (user,tty,pid) = jid user LocalHost tty + +getUserStatus state user = do + (tty,users) <- atomically $ do + tty <- readTVar $ currentTTY state + users <- readTVar $ activeUsers state + return (tty,users) + let jids = Set.filter (\(name,tty,pid) -> name ==user) users + ps = map (\jid -> Presence (tupleToJID jid) (matchResource' tty jid)) . Set.toList $ jids + if null ps + then return [Presence (JID { name=Just user, peer=LocalHost, resource=Nothing }) Offline] + else return ps + + + data RefCountedChan = forall a. RefCountedChan (TMVar (RefCount,TChan a)) subscribeToChan :: TMVar (RefCount, TChan a) -> STM (TChan a) -- cgit v1.2.3