Work toward sending outgoing messages to remote peers

1 files changed, 13 insertions, 1 deletions

diff --git a/Presence/main.hs b/Presence/main.hs
index e416d7cc..b0721292 100644
--- a/Presence/main.hs
+++ b/Presence/main.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE TypeFamilies      #-}
 module Main where
 
+import Debug.Trace
 import System.Directory
 import Control.Monad
 import System.Posix.Signals
@@ -10,6 +11,7 @@ import System.Posix.Types
 import System.Posix.Process
 import Data.Maybe
 import Data.Char
+import ConfigFiles
 
 import System.INotify
 #ifndef NOUTMP
@@ -36,7 +38,7 @@ import qualified Data.Map as Map
 import           Data.Map as Map (Map)
 
 import Control.Concurrent.STM
-import Control.Concurrent (threadDelay)
+import Control.Concurrent
 import Control.Monad.Trans.Maybe
 import Control.Monad.IO.Class
 
@@ -187,12 +189,21 @@ on_chvt state vtnum = do
         return (us,fmap snd subs,fmap snd greedy)
     update_presence greedy subs users $ matchResource tty
 
+data UnixConfig = UnixConfig
+
+instance XMPPConfig UnixConfig where
+    getBuddies     _ user = ConfigFiles.getBuddies user
+    getSubscribers _ user = ConfigFiles.getSubscribers user
 
 start :: ByteString -> IO ()
 start host = do
     tracked <- newPresenceState host
     let dologin e = track_login host tracked e
         dologin :: t -> IO ()
+
+    chan <- atomically $ subscribeToChan (greedySubscriber tracked)
+    remotes <- forkIO $ seekRemotePeers (/=host) UnixConfig chan
+
     installHandler sigUSR1 (Catch (dologin (userError "signaled"))) Nothing
     -- installHandler sigTERM (CatchOnce (dologin (userError "term signaled"))) Nothing
     mtty <- monitorTTY (on_chvt tracked)
@@ -211,6 +222,7 @@ start host = do
     dologin ()
     putStrLn "\nHit enter to terminate...\n"
     getLine
+    killThread remotes
     sClose sockLocals
     sClose sockRemotes
     -- threadDelay 1000