From 2b0b81054f19460a465fd0228279c9b6d3b8c1a2 Mon Sep 17 00:00:00 2001 From: joe Date: Mon, 1 Jul 2013 20:50:44 -0400 Subject: progress toward sending presence probes --- Presence/XMPP.hs | 8 +------- Presence/main.hs | 17 +++++++++++++++++ 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 import XMPPTypes import SocketLike import ByteStringOperators +import ControlMaybe import Data.HList import Network.Socket @@ -225,13 +226,6 @@ uncontent cs = head $ map getText cs getText (ContentText x) = x getText (ContentEntity x ) = x -withJust (Just x) f = f x -withJust Nothing f = return () - -whenJust acn f = do - x <- acn - withJust x f - tagAttrs (EventBeginElement _ xs) = xs tagAttrs _ = [] 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 #else import XMPP #endif +import ControlMaybe import Data.HList import Control.Exception import LocalPeerCred @@ -229,6 +230,20 @@ newPresenceState hostname = atomically $ do remotes <- newTVar (Map.empty) return $ PresenceState hostname tty us subs locals_greedy remotes +sendProbes state jid = do + withJust (name jid) $ \user -> do + buddies <- do + buddies <- ConfigFiles.getBuddies user + mapM parseHostNameJID buddies + remotes <- readTVarIO (remoteUsers state) + forM_ buddies $ \buddy -> do + let mjids = fmap snd $ Map.lookup (peer buddy) remotes + jids <- maybe (return Set.empty) readTVarIO mjids + let noinfo = Set.notMember buddy jids + when noinfo $ do + -- TODO ... sendMessage + return () + track_login host state e = do #ifndef NOUTMP us <- UTmp.users @@ -250,6 +265,8 @@ track_login host state e = do departures = known_users \\ new_users update_presence locals_greedy subs departures $ const Offline update_presence locals_greedy subs arrivals $ matchResource tty + forM_ (Set.toList arrivals) + $ sendProbes state on_chvt state vtnum = do let tty = L.snoc "tty" $ intToDigit (fromIntegral vtnum) -- cgit v1.2.3