summaryrefslogtreecommitdiff
path: root/Presence
diff options
context:
space:
mode:
Diffstat (limited to 'Presence')
-rw-r--r--Presence/XMPP.hs8
-rw-r--r--Presence/main.hs17
2 files changed, 18 insertions, 7 deletions
diff --git a/Presence/XMPP.hs b/Presence/XMPP.hs
index 3d20a9b8..86f2df44 100644
--- a/Presence/XMPP.hs
+++ b/Presence/XMPP.hs
@@ -15,6 +15,7 @@ import ServerC
15import XMPPTypes 15import XMPPTypes
16import SocketLike 16import SocketLike
17import ByteStringOperators 17import ByteStringOperators
18import ControlMaybe
18 19
19import Data.HList 20import Data.HList
20import Network.Socket 21import Network.Socket
@@ -225,13 +226,6 @@ uncontent cs = head $ map getText cs
225 getText (ContentText x) = x 226 getText (ContentText x) = x
226 getText (ContentEntity x ) = x 227 getText (ContentEntity x ) = x
227 228
228withJust (Just x) f = f x
229withJust Nothing f = return ()
230
231whenJust acn f = do
232 x <- acn
233 withJust x f
234
235tagAttrs (EventBeginElement _ xs) = xs 229tagAttrs (EventBeginElement _ xs) = xs
236tagAttrs _ = [] 230tagAttrs _ = []
237 231
diff --git a/Presence/main.hs b/Presence/main.hs
index 3182431f..37fe1a2e 100644
--- a/Presence/main.hs
+++ b/Presence/main.hs
@@ -33,6 +33,7 @@ import XMPPServer
33#else 33#else
34import XMPP 34import XMPP
35#endif 35#endif
36import ControlMaybe
36import Data.HList 37import Data.HList
37import Control.Exception 38import Control.Exception
38import LocalPeerCred 39import LocalPeerCred
@@ -229,6 +230,20 @@ newPresenceState hostname = atomically $ do
229 remotes <- newTVar (Map.empty) 230 remotes <- newTVar (Map.empty)
230 return $ PresenceState hostname tty us subs locals_greedy remotes 231 return $ PresenceState hostname tty us subs locals_greedy remotes
231 232
233sendProbes state jid = do
234 withJust (name jid) $ \user -> do
235 buddies <- do
236 buddies <- ConfigFiles.getBuddies user
237 mapM parseHostNameJID buddies
238 remotes <- readTVarIO (remoteUsers state)
239 forM_ buddies $ \buddy -> do
240 let mjids = fmap snd $ Map.lookup (peer buddy) remotes
241 jids <- maybe (return Set.empty) readTVarIO mjids
242 let noinfo = Set.notMember buddy jids
243 when noinfo $ do
244 -- TODO ... sendMessage
245 return ()
246
232track_login host state e = do 247track_login host state e = do
233#ifndef NOUTMP 248#ifndef NOUTMP
234 us <- UTmp.users 249 us <- UTmp.users
@@ -250,6 +265,8 @@ track_login host state e = do
250 departures = known_users \\ new_users 265 departures = known_users \\ new_users
251 update_presence locals_greedy subs departures $ const Offline 266 update_presence locals_greedy subs departures $ const Offline
252 update_presence locals_greedy subs arrivals $ matchResource tty 267 update_presence locals_greedy subs arrivals $ matchResource tty
268 forM_ (Set.toList arrivals)
269 $ sendProbes state
253 270
254on_chvt state vtnum = do 271on_chvt state vtnum = do
255 let tty = L.snoc "tty" $ intToDigit (fromIntegral vtnum) 272 let tty = L.snoc "tty" $ intToDigit (fromIntegral vtnum)