From fa6a523704984bd98762a4e639b739e73320068f Mon Sep 17 00:00:00 2001 From: joe Date: Thu, 20 Jun 2013 18:50:18 -0400 Subject: Work toward sending outgoing messages to remote peers --- Presence/main.hs | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) (limited to 'Presence/main.hs') 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 -- cgit v1.2.3