diff options
Diffstat (limited to 'Presence')
-rw-r--r-- | Presence/XMPP.hs | 8 | ||||
-rw-r--r-- | 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 | |||
15 | import XMPPTypes | 15 | import XMPPTypes |
16 | import SocketLike | 16 | import SocketLike |
17 | import ByteStringOperators | 17 | import ByteStringOperators |
18 | import ControlMaybe | ||
18 | 19 | ||
19 | import Data.HList | 20 | import Data.HList |
20 | import Network.Socket | 21 | import 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 | ||
228 | withJust (Just x) f = f x | ||
229 | withJust Nothing f = return () | ||
230 | |||
231 | whenJust acn f = do | ||
232 | x <- acn | ||
233 | withJust x f | ||
234 | |||
235 | tagAttrs (EventBeginElement _ xs) = xs | 229 | tagAttrs (EventBeginElement _ xs) = xs |
236 | tagAttrs _ = [] | 230 | tagAttrs _ = [] |
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 |
34 | import XMPP | 34 | import XMPP |
35 | #endif | 35 | #endif |
36 | import ControlMaybe | ||
36 | import Data.HList | 37 | import Data.HList |
37 | import Control.Exception | 38 | import Control.Exception |
38 | import LocalPeerCred | 39 | import 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 | ||
233 | sendProbes 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 | |||
232 | track_login host state e = do | 247 | track_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 | ||
254 | on_chvt state vtnum = do | 271 | on_chvt state vtnum = do |
255 | let tty = L.snoc "tty" $ intToDigit (fromIntegral vtnum) | 272 | let tty = L.snoc "tty" $ intToDigit (fromIntegral vtnum) |