summaryrefslogtreecommitdiff
path: root/Presence/main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Presence/main.hs')
-rw-r--r--Presence/main.hs20
1 files changed, 15 insertions, 5 deletions
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 =
97 97
98data ClientSession = ClientSession { 98data ClientSession = ClientSession {
99 localhost :: Peer, -- ByteString, 99 localhost :: Peer, -- ByteString,
100 unix_uid :: (IORef (Maybe UserID)), 100 unix_uid :: (IORef (Maybe (UserID,L.ByteString))),
101 unix_resource :: (IORef (Maybe L.ByteString)), 101 unix_resource :: (IORef (Maybe L.ByteString)),
102 presence_state :: PresenceState 102 presence_state :: PresenceState
103} 103}
@@ -106,7 +106,9 @@ instance JabberClientSession ClientSession where
106 data XMPPClass ClientSession = ClientSessions PresenceState 106 data XMPPClass ClientSession = ClientSessions PresenceState
107 107
108 newSession (ClientSessions state) sock = do 108 newSession (ClientSessions state) sock = do
109 muid <- getLocalPeerCred sock 109 -- muid <- getLocalPeerCred sock
110 addr <- getPeerName sock
111 muid <- getLocalPeerCred' addr
110 L.putStrLn $ "CLIENT SESSION: open " <++> bshow muid 112 L.putStrLn $ "CLIENT SESSION: open " <++> bshow muid
111 uid_ref <- newIORef muid 113 uid_ref <- newIORef muid
112 res_ref <- newIORef Nothing 114 res_ref <- newIORef Nothing
@@ -114,12 +116,20 @@ instance JabberClientSession ClientSession where
114 116
115 setResource s resource = do 117 setResource s resource = do
116 -- TODO: handle resource = empty string 118 -- TODO: handle resource = empty string
117 writeIORef (unix_resource s) (Just resource) 119 us <- fmap Set.toList . readTVarIO $ activeUsers (presence_state s)
118 L.putStrLn $ "CLIENT SESSION: resource " <++> resource 120 muid <- readIORef (unix_uid s)
121 let tailOf3 (_,a,b) = (a,b)
122 (t,pid) <- case muid of
123 Just (uid,inode) -> identifyTTY (map tailOf3 us) uid inode
124 Nothing -> return (Nothing,Nothing)
125 let rsc = t `mplus` fmap ( ("pid."<++>) . bshow ) pid
126 rsc' = maybe resource id rsc
127 writeIORef (unix_resource s) (Just rsc')
128 L.putStrLn $ "CLIENT SESSION: resource " <++> rsc'
119 129
120 getJID s = do 130 getJID s = do
121 let host = localhost s 131 let host = localhost s
122 muid <- readIORef (unix_uid s) 132 muid <- fmap (fmap fst) $ readIORef (unix_uid s)
123 user <- getJabberUserForId muid 133 user <- getJabberUserForId muid
124 134
125 rsc <- readIORef (unix_resource s) 135 rsc <- readIORef (unix_resource s)