1 files changed, 21 insertions, 11 deletions

diff --git a/Presence/main.hs b/Presence/main.hs
index e8c07788..7b3a7826 100644
--- a/Presence/main.hs
+++ b/Presence/main.hs
@@ -75,7 +75,7 @@ unsplitResource (JabberUser n p) r = JID (Just n) p r
 data PresenceState = PresenceState 
     { hostname :: Peer -- ByteString, TODO: remove this, its always LocalHost now
     , currentTTY    :: TVar ByteString
-    , activeUsers   :: TVar (Set JID)
+    , activeUsers   :: TVar (Set (UserName, Tty, ProcessID))
     , subscriberMap :: TVar (Map JID (RefCount,TChan Presence)) -- UNUSED as yet
     , localSubscriber :: TMVar (RefCount,TChan Presence) -- TODO: rename this, its not just locals
                                                          -- ... or make a seperate channel for remotes
@@ -159,6 +159,8 @@ instance JabberClientSession ClientSession where
             L.putStrLn $ "cached presence: " <++> bshow p
             action p
 
+tupleToJID (user,tty,pid) = jid user LocalHost tty
+
 data PeerSession = PeerSession {
     announced :: TVar (MultiMap JabberUser (JabberResource,JabberShow)),
     peer_name :: Peer,
@@ -194,8 +196,8 @@ instance JabberPeerSession PeerSession where
             tty <- readTVar $ currentTTY state
             users <- readTVar $ activeUsers state
             return (tty,users)
-        let jids = Set.filter (\jid->name jid==Just user) users
-            ps = map (\jid -> Presence jid (matchResource tty jid)) . Set.toList $ jids
+        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
@@ -205,7 +207,7 @@ instance JabberPeerSession PeerSession where
             subs <- readTVar $ subscriberMap (peer_global session)
             greedy <- fmap snd $ readTMVar $ localSubscriber (peer_global session)
             return (greedy,subs)
-        update_presence (Just greedy) (fmap snd subs) (Set.singleton jid) (const status)
+        update_presence (Just greedy) (fmap snd subs) [jid] (const status)
         liftIO . atomically $ do
             jids <- readTVar . announced $ session
             withJust (splitResource jid) $ \(u,rsc) -> do
@@ -264,13 +266,18 @@ matchResource tty jid = maybe Away (avail . (==tty)) $ resource jid
     avail True  = Available
     avail False = Away
 
+matchResource' tty (_,rsc,_) = avail  (rsc==tty)
+ where
+    avail True  = Available
+    avail False = Away
+
 sendPresence chan jid status = 
     (liftIO  . atomically . writeTChan chan . Presence jid $ status) :: MaybeT IO ()
 
 lookupT jid subscribers = MaybeT . return $ Map.lookup jid subscribers 
 
 update_presence locals_greedy subscribers state getStatus =
-    forM_ (Set.toList state) $ \jid -> do
+    forM_ state $ \jid -> do
       let status = getStatus jid 
       runMaybeT $ do
         chan <- lookupT jid subscribers
@@ -316,9 +323,9 @@ track_login host state e = do
 #else
     let us = []
 #endif
-    let toJabberId host (user,tty,_) = 
+    let toJabberId host (user,tty,pid) = 
             if L.take 3 tty == "tty"
-              then Just (jid user host tty)
+              then Just (user,tty,pid) -- (jid user host tty)
               else Nothing
         new_users = Set.fromList $ mapMaybe (toJabberId host) us
     (tty,known_users,subs,locals_greedy) <- atomically $ do
@@ -327,11 +334,11 @@ track_login host state e = do
             xs  <- readTVar                $ subscriberMap state
             locals_greedy <- tryReadTMVar $ localSubscriber state
             return (tty,st,fmap snd xs,fmap snd locals_greedy)
-    let arrivals   = new_users \\ known_users
-        departures = known_users \\ new_users
+    let arrivals   = map tupleToJID . Set.toList $ new_users \\ known_users
+        departures = map tupleToJID . Set.toList $ known_users \\ new_users
     update_presence locals_greedy subs departures $ const Offline
     update_presence locals_greedy subs arrivals   $ matchResource tty
-    forM_ (Set.toList arrivals)
+    forM_ arrivals
           $ sendProbes state
 
 on_chvt state vtnum = do
@@ -343,7 +350,10 @@ on_chvt state vtnum = do
         writeTVar (currentTTY state) tty
         locals_greedy <- tryReadTMVar $ localSubscriber state
         return (us,fmap snd subs,fmap snd locals_greedy)
-    update_presence locals_greedy subs users $ matchResource tty
+    update_presence locals_greedy 
+                    subs 
+                    (map tupleToJID . Set.toList $ users) 
+                    $ matchResource tty
 
 start :: Network.Socket.Family -> IO ()
 start ip4or6 = do