summaryrefslogtreecommitdiff
path: root/Presence/main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Presence/main.hs')
-rw-r--r--Presence/main.hs14
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 @@
3{-# LANGUAGE TypeFamilies #-} 3{-# LANGUAGE TypeFamilies #-}
4module Main where 4module Main where
5 5
6import Debug.Trace
6import System.Directory 7import System.Directory
7import Control.Monad 8import Control.Monad
8import System.Posix.Signals 9import System.Posix.Signals
@@ -10,6 +11,7 @@ import System.Posix.Types
10import System.Posix.Process 11import System.Posix.Process
11import Data.Maybe 12import Data.Maybe
12import Data.Char 13import Data.Char
14import ConfigFiles
13 15
14import System.INotify 16import System.INotify
15#ifndef NOUTMP 17#ifndef NOUTMP
@@ -36,7 +38,7 @@ import qualified Data.Map as Map
36import Data.Map as Map (Map) 38import Data.Map as Map (Map)
37 39
38import Control.Concurrent.STM 40import Control.Concurrent.STM
39import Control.Concurrent (threadDelay) 41import Control.Concurrent
40import Control.Monad.Trans.Maybe 42import Control.Monad.Trans.Maybe
41import Control.Monad.IO.Class 43import Control.Monad.IO.Class
42 44
@@ -187,12 +189,21 @@ on_chvt state vtnum = do
187 return (us,fmap snd subs,fmap snd greedy) 189 return (us,fmap snd subs,fmap snd greedy)
188 update_presence greedy subs users $ matchResource tty 190 update_presence greedy subs users $ matchResource tty
189 191
192data UnixConfig = UnixConfig
193
194instance XMPPConfig UnixConfig where
195 getBuddies _ user = ConfigFiles.getBuddies user
196 getSubscribers _ user = ConfigFiles.getSubscribers user
190 197
191start :: ByteString -> IO () 198start :: ByteString -> IO ()
192start host = do 199start host = do
193 tracked <- newPresenceState host 200 tracked <- newPresenceState host
194 let dologin e = track_login host tracked e 201 let dologin e = track_login host tracked e
195 dologin :: t -> IO () 202 dologin :: t -> IO ()
203
204 chan <- atomically $ subscribeToChan (greedySubscriber tracked)
205 remotes <- forkIO $ seekRemotePeers (/=host) UnixConfig chan
206
196 installHandler sigUSR1 (Catch (dologin (userError "signaled"))) Nothing 207 installHandler sigUSR1 (Catch (dologin (userError "signaled"))) Nothing
197 -- installHandler sigTERM (CatchOnce (dologin (userError "term signaled"))) Nothing 208 -- installHandler sigTERM (CatchOnce (dologin (userError "term signaled"))) Nothing
198 mtty <- monitorTTY (on_chvt tracked) 209 mtty <- monitorTTY (on_chvt tracked)
@@ -211,6 +222,7 @@ start host = do
211 dologin () 222 dologin ()
212 putStrLn "\nHit enter to terminate...\n" 223 putStrLn "\nHit enter to terminate...\n"
213 getLine 224 getLine
225 killThread remotes
214 sClose sockLocals 226 sClose sockLocals
215 sClose sockRemotes 227 sClose sockRemotes
216 -- threadDelay 1000 228 -- threadDelay 1000