progress toward sending presence probes

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)