From 5e8f82e436c03e1c59e69d5c9eb0e5a14284dd87 Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Sun, 12 Nov 2017 20:35:00 -0500
Subject: We no longer require root. (ConsoleWriter is disabled without).

---
 Presence/Presence.hs | 17 +++++++++++------
 1 file changed, 11 insertions(+), 6 deletions(-)

(limited to 'Presence/Presence.hs')

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
     , associatedPeers :: TVar (Map SockAddr ())
     , server :: TMVar XMPPServer
     , keyToChan :: TVar (Map ConnectionKey Conn)
-    , consoleWriter :: ConsoleWriter
+    , consoleWriter :: Maybe ConsoleWriter
     }
 
 
@@ -435,11 +435,11 @@ rewriteJIDForPeer jid = do
         in (to',addr)
 
 deliverToConsole :: PresenceState -> IO () -> Stanza -> IO ()
-deliverToConsole state fail msg = do
-    putStrLn $ "TODO: deliver to console"
-    did1 <- writeActiveTTY (consoleWriter state) msg
-    did2 <- writeAllPty (consoleWriter state) msg
+deliverToConsole PresenceState{ consoleWriter = Just cw } fail msg = do
+    did1 <- writeActiveTTY cw msg
+    did2 <- writeAllPty cw msg
     if not (did1 || did2) then fail else return ()
+deliverToConsole _ fail _ = fail
 
 -- | deliver <message/> or error stanza
 deliverMessage :: PresenceState
@@ -636,6 +636,11 @@ informPeerPresence state k stanza = do
         sendModifiedStanzaToClient (dup { stanzaFrom=Just from' })
                                    (connChan con)
 
+consoleClients :: PresenceState -> STM (Map Text ClientState)
+consoleClients PresenceState{ consoleWriter = Just cw } = readTVar (cwClients cw)
+consoleClients _                                        = return Map.empty
+
+
 answerProbe :: PresenceState
              -> Maybe Text -> ConnectionKey -> TChan Stanza -> IO ()
 answerProbe state mto k chan = do
@@ -671,7 +676,7 @@ answerProbe state mto k chan = do
     replies <- runTraversableT $ do
         cbu <- lift . atomically $ readTVar (clientsByUser state)
         let lpres = maybeToList $ Map.lookup u cbu
-        cw <- lift . atomically $ readTVar (cwClients $ consoleWriter state)
+        cw <- lift . atomically $ consoleClients state
         clientState <- liftT $ (lpres >>= Map.elems . networkClients)
                                 ++ Map.elems cw
         stanza <- liftIOMaybe $ atomically (readTVar (clientStatus clientState))
-- 
cgit v1.2.3