From f183eca9bc5b531f32ec9302e7c9a538a88beb9c Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Fri, 5 Jul 2013 17:36:05 -0400
Subject: Now assigns tty for resource id.

---
 Presence/main.hs | 20 +++++++++++++++-----
 1 file changed, 15 insertions(+), 5 deletions(-)

(limited to 'Presence/main.hs')

diff --git a/Presence/main.hs b/Presence/main.hs
index 7b3a7826..cd7d7898 100644
--- a/Presence/main.hs
+++ b/Presence/main.hs
@@ -97,7 +97,7 @@ getJabberUserForId muid =
 
 data ClientSession = ClientSession {
     localhost :: Peer, -- ByteString,
-    unix_uid :: (IORef (Maybe UserID)),
+    unix_uid :: (IORef (Maybe (UserID,L.ByteString))),
     unix_resource :: (IORef (Maybe L.ByteString)),
     presence_state :: PresenceState
 }
@@ -106,7 +106,9 @@ instance JabberClientSession ClientSession where
     data XMPPClass ClientSession = ClientSessions PresenceState
 
     newSession (ClientSessions state) sock = do
-        muid <- getLocalPeerCred sock
+        -- muid <- getLocalPeerCred sock
+        addr <- getPeerName sock
+        muid <- getLocalPeerCred' addr
         L.putStrLn $ "CLIENT SESSION: open " <++> bshow muid
         uid_ref <- newIORef muid
         res_ref <- newIORef Nothing
@@ -114,12 +116,20 @@ instance JabberClientSession ClientSession where
 
     setResource  s  resource    = do
         -- TODO: handle resource = empty string 
-        writeIORef (unix_resource s) (Just resource)
-        L.putStrLn $ "CLIENT SESSION: resource " <++> resource
+        us <- fmap Set.toList . readTVarIO $ activeUsers (presence_state s)
+        muid <- readIORef (unix_uid s)
+        let tailOf3 (_,a,b) = (a,b)
+        (t,pid) <- case muid of
+                      Just (uid,inode) -> identifyTTY (map tailOf3 us) uid inode
+                      Nothing          -> return (Nothing,Nothing)
+        let rsc = t `mplus` fmap ( ("pid."<++>) . bshow ) pid
+            rsc' = maybe resource id rsc
+        writeIORef (unix_resource s) (Just rsc')
+        L.putStrLn $ "CLIENT SESSION: resource " <++> rsc'
 
     getJID       s             = do
         let host = localhost s
-        muid <- readIORef (unix_uid s)
+        muid <- fmap (fmap fst) $ readIORef (unix_uid s)
         user <- getJabberUserForId muid
 
         rsc <- readIORef (unix_resource s)
-- 
cgit v1.2.3