summaryrefslogtreecommitdiff
path: root/Presence/main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Presence/main.hs')
-rw-r--r--Presence/main.hs56
1 files changed, 41 insertions, 15 deletions
diff --git a/Presence/main.hs b/Presence/main.hs
index 5cccffea..702b98d5 100644
--- a/Presence/main.hs
+++ b/Presence/main.hs
@@ -222,7 +222,7 @@ instance JabberClientSession ClientSession where
222 else return Nothing 222 else return Nothing
223 atomically $ do 223 atomically $ do
224 whenJust getRChan $ \rchan -> do 224 whenJust getRChan $ \rchan -> do
225 forM_ pending (writeTChan rchan . PendingBuddy user) 225 forM_ pending (writeTChan rchan . PendingSubscriber user)
226 226
227 addSolicited s jid_str jid = do 227 addSolicited s jid_str jid = do
228 me <- getJID s 228 me <- getJID s
@@ -264,6 +264,16 @@ instance JabberClientSession ClientSession where
264 msubs <- mapM (cmpJID cjid) subs 264 msubs <- mapM (cmpJID cjid) subs
265 return (Nothing `elem` msubs) 265 return (Nothing `elem` msubs)
266 266
267 isBuddy s contact = do
268 handleIO (\e -> return False) $ do
269 user <- readIORef (unix_uid s) >>= getJabberUserForId
270 subs <- ConfigFiles.getBuddies user
271 putStrLn $ "isBuddy parsing: "<++>contact
272 cjid <- parseHostNameJID contact
273 msubs <- mapM (cmpJID cjid) subs
274 return (Nothing `elem` msubs)
275
276
267 approveSubscriber s contact = do 277 approveSubscriber s contact = do
268 user <- readIORef (unix_uid s) >>= getJabberUserForId 278 user <- readIORef (unix_uid s) >>= getJabberUserForId
269 cjid <- parseHostNameJID contact 279 cjid <- parseHostNameJID contact
@@ -271,16 +281,40 @@ instance JabberClientSession ClientSession where
271 addRawJid ConfigFiles.modifySubscribers user contact -- add subscribers 281 addRawJid ConfigFiles.modifySubscribers user contact -- add subscribers
272 rmjid ConfigFiles.modifyPending user cjid 282 rmjid ConfigFiles.modifyPending user cjid
273 rmjid ConfigFiles.modifyOthers user cjid 283 rmjid ConfigFiles.modifyOthers user cjid
274 -- TODO 284
275 -- roster push (to other clients, or do we include the approver?) 285 -- roster push
286 let rchan = rosterChannel . presence_state $ s
287 atomically $ do
288 isempty <- isEmptyTMVar rchan
289 when (not isempty) $ do
290 (_,ch) <- readTMVar rchan
291 writeTChan ch (NewSubscriber user contact)
292
293 -- notify peer
276 sendMessage (outGoingConnections . presence_state $ s) 294 sendMessage (outGoingConnections . presence_state $ s)
277 (Approval (JID (Just user) LocalHost Nothing) 295 (Approval (JID (Just user) LocalHost Nothing)
278 cjid) 296 cjid)
279 (peer cjid) 297 (peer cjid)
298 presence <- getUserStatus (presence_state s) user
299 let cons = outGoingConnections . presence_state $ s
300 forM_ presence $ \p -> sendMessage cons (OutBoundPresence p) (peer cjid)
301 return ()
280 302
281 303
282tupleToJID (user,tty,pid) = jid user LocalHost tty 304tupleToJID (user,tty,pid) = jid user LocalHost tty
283 305
306getUserStatus state user = do
307 (tty,users) <- atomically $ do
308 tty <- readTVar $ currentTTY state
309 users <- readTVar $ activeUsers state
310 return (tty,users)
311 let jids = Set.filter (\(name,tty,pid) -> name ==user) users
312 ps = map (\jid -> Presence (tupleToJID jid) (matchResource' tty jid)) . Set.toList $ jids
313 if null ps
314 then return [Presence (JID { name=Just user, peer=LocalHost, resource=Nothing }) Offline]
315 else return ps
316
317
284data PeerSession = PeerSession { 318data PeerSession = PeerSession {
285 announced :: TVar (MultiMap JabberUser (JabberResource,JabberShow)), 319 announced :: TVar (MultiMap JabberUser (JabberResource,JabberShow)),
286 peer_name :: Peer, 320 peer_name :: Peer,
@@ -310,18 +344,10 @@ instance JabberPeerSession PeerSession where
310 344
311 peerAddress session = peer_name session 345 peerAddress session = peer_name session
312 346
313 userStatus session user = do 347 userStatus session user = getUserStatus (peer_global session) user
314 let state = peer_global session
315 (tty,users) <- atomically $ do
316 tty <- readTVar $ currentTTY state
317 users <- readTVar $ activeUsers state
318 return (tty,users)
319 let jids = Set.filter (\(name,tty,pid) -> name ==user) users
320 ps = map (\jid -> Presence (tupleToJID jid) (matchResource' tty jid)) . Set.toList $ jids
321 if null ps
322 then return [Presence (JID { name=Just user, peer=LocalHost, resource=Nothing }) Offline]
323 else return ps
324 348
349 -- This should be used on inbound presence to inform clients.
350 -- For outbound, use sendPeerMessage and OutBoundPresence.
325 announcePresence session (Presence jid status) = do 351 announcePresence session (Presence jid status) = do
326 (greedy,subs) <- atomically $ do 352 (greedy,subs) <- atomically $ do
327 subs <- readTVar $ subscriberMap (peer_global session) 353 subs <- readTVar $ subscriberMap (peer_global session)
@@ -384,7 +410,7 @@ instance JabberPeerSession PeerSession where
384 isempty <- isEmptyTMVar rchan 410 isempty <- isEmptyTMVar rchan
385 when (not isempty) $ do 411 when (not isempty) $ do
386 (_,ch) <- readTMVar rchan 412 (_,ch) <- readTMVar rchan
387 writeTChan ch (PendingBuddy user buddy) 413 writeTChan ch (PendingSubscriber user buddy)
388 414
389 415
390data RefCountedChan = forall a. RefCountedChan (TMVar (RefCount,TChan a)) 416data RefCountedChan = forall a. RefCountedChan (TMVar (RefCount,TChan a))