diff options
Diffstat (limited to 'Presence/main.hs')
-rw-r--r-- | Presence/main.hs | 14 |
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 #-} |
4 | module Main where | 4 | module Main where |
5 | 5 | ||
6 | import Debug.Trace | ||
6 | import System.Directory | 7 | import System.Directory |
7 | import Control.Monad | 8 | import Control.Monad |
8 | import System.Posix.Signals | 9 | import System.Posix.Signals |
@@ -10,6 +11,7 @@ import System.Posix.Types | |||
10 | import System.Posix.Process | 11 | import System.Posix.Process |
11 | import Data.Maybe | 12 | import Data.Maybe |
12 | import Data.Char | 13 | import Data.Char |
14 | import ConfigFiles | ||
13 | 15 | ||
14 | import System.INotify | 16 | import System.INotify |
15 | #ifndef NOUTMP | 17 | #ifndef NOUTMP |
@@ -36,7 +38,7 @@ import qualified Data.Map as Map | |||
36 | import Data.Map as Map (Map) | 38 | import Data.Map as Map (Map) |
37 | 39 | ||
38 | import Control.Concurrent.STM | 40 | import Control.Concurrent.STM |
39 | import Control.Concurrent (threadDelay) | 41 | import Control.Concurrent |
40 | import Control.Monad.Trans.Maybe | 42 | import Control.Monad.Trans.Maybe |
41 | import Control.Monad.IO.Class | 43 | import 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 | ||
192 | data UnixConfig = UnixConfig | ||
193 | |||
194 | instance XMPPConfig UnixConfig where | ||
195 | getBuddies _ user = ConfigFiles.getBuddies user | ||
196 | getSubscribers _ user = ConfigFiles.getSubscribers user | ||
190 | 197 | ||
191 | start :: ByteString -> IO () | 198 | start :: ByteString -> IO () |
192 | start host = do | 199 | start 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 |