diff options
Diffstat (limited to 'Presence/Presence.hs')
-rw-r--r-- | Presence/Presence.hs | 17 |
1 files changed, 11 insertions, 6 deletions
diff --git a/Presence/Presence.hs b/Presence/Presence.hs index 2344fb75..9660b29f 100644 --- a/Presence/Presence.hs +++ b/Presence/Presence.hs | |||
@@ -148,7 +148,7 @@ data PresenceState = PresenceState | |||
148 | , associatedPeers :: TVar (Map SockAddr ()) | 148 | , associatedPeers :: TVar (Map SockAddr ()) |
149 | , server :: TMVar XMPPServer | 149 | , server :: TMVar XMPPServer |
150 | , keyToChan :: TVar (Map ConnectionKey Conn) | 150 | , keyToChan :: TVar (Map ConnectionKey Conn) |
151 | , consoleWriter :: ConsoleWriter | 151 | , consoleWriter :: Maybe ConsoleWriter |
152 | } | 152 | } |
153 | 153 | ||
154 | 154 | ||
@@ -435,11 +435,11 @@ rewriteJIDForPeer jid = do | |||
435 | in (to',addr) | 435 | in (to',addr) |
436 | 436 | ||
437 | deliverToConsole :: PresenceState -> IO () -> Stanza -> IO () | 437 | deliverToConsole :: PresenceState -> IO () -> Stanza -> IO () |
438 | deliverToConsole state fail msg = do | 438 | deliverToConsole PresenceState{ consoleWriter = Just cw } fail msg = do |
439 | putStrLn $ "TODO: deliver to console" | 439 | did1 <- writeActiveTTY cw msg |
440 | did1 <- writeActiveTTY (consoleWriter state) msg | 440 | did2 <- writeAllPty cw msg |
441 | did2 <- writeAllPty (consoleWriter state) msg | ||
442 | if not (did1 || did2) then fail else return () | 441 | if not (did1 || did2) then fail else return () |
442 | deliverToConsole _ fail _ = fail | ||
443 | 443 | ||
444 | -- | deliver <message/> or error stanza | 444 | -- | deliver <message/> or error stanza |
445 | deliverMessage :: PresenceState | 445 | deliverMessage :: PresenceState |
@@ -636,6 +636,11 @@ informPeerPresence state k stanza = do | |||
636 | sendModifiedStanzaToClient (dup { stanzaFrom=Just from' }) | 636 | sendModifiedStanzaToClient (dup { stanzaFrom=Just from' }) |
637 | (connChan con) | 637 | (connChan con) |
638 | 638 | ||
639 | consoleClients :: PresenceState -> STM (Map Text ClientState) | ||
640 | consoleClients PresenceState{ consoleWriter = Just cw } = readTVar (cwClients cw) | ||
641 | consoleClients _ = return Map.empty | ||
642 | |||
643 | |||
639 | answerProbe :: PresenceState | 644 | answerProbe :: PresenceState |
640 | -> Maybe Text -> ConnectionKey -> TChan Stanza -> IO () | 645 | -> Maybe Text -> ConnectionKey -> TChan Stanza -> IO () |
641 | answerProbe state mto k chan = do | 646 | answerProbe state mto k chan = do |
@@ -671,7 +676,7 @@ answerProbe state mto k chan = do | |||
671 | replies <- runTraversableT $ do | 676 | replies <- runTraversableT $ do |
672 | cbu <- lift . atomically $ readTVar (clientsByUser state) | 677 | cbu <- lift . atomically $ readTVar (clientsByUser state) |
673 | let lpres = maybeToList $ Map.lookup u cbu | 678 | let lpres = maybeToList $ Map.lookup u cbu |
674 | cw <- lift . atomically $ readTVar (cwClients $ consoleWriter state) | 679 | cw <- lift . atomically $ consoleClients state |
675 | clientState <- liftT $ (lpres >>= Map.elems . networkClients) | 680 | clientState <- liftT $ (lpres >>= Map.elems . networkClients) |
676 | ++ Map.elems cw | 681 | ++ Map.elems cw |
677 | stanza <- liftIOMaybe $ atomically (readTVar (clientStatus clientState)) | 682 | stanza <- liftIOMaybe $ atomically (readTVar (clientStatus clientState)) |