1804
|
1 |
{-# LANGUAGE CPP, ScopedTypeVariables, PatternSignatures #-}
|
|
2 |
|
|
3 |
module Main where
|
|
4 |
|
|
5 |
import Network.Socket
|
|
6 |
import qualified Network
|
|
7 |
import Control.Concurrent.STM
|
|
8 |
import Control.Concurrent.Chan
|
|
9 |
import Control.Exception
|
|
10 |
import System.Log.Logger
|
|
11 |
-----------------------------------
|
|
12 |
import Opts
|
|
13 |
import CoreTypes
|
|
14 |
import OfficialServer.DBInteraction
|
|
15 |
import ServerCore
|
|
16 |
|
|
17 |
|
|
18 |
#if !defined(mingw32_HOST_OS)
|
|
19 |
import System.Posix
|
|
20 |
#endif
|
|
21 |
|
|
22 |
|
|
23 |
{-data Messages =
|
|
24 |
Accept ClientInfo
|
|
25 |
| ClientMessage ([String], ClientInfo)
|
|
26 |
| CoreMessage [String]
|
|
27 |
| TimerTick
|
|
28 |
|
|
29 |
messagesLoop :: TChan String -> IO()
|
|
30 |
messagesLoop messagesChan = forever $ do
|
|
31 |
threadDelay (25 * 10^6) -- 25 seconds
|
|
32 |
atomically $ writeTChan messagesChan "PING"
|
|
33 |
|
|
34 |
timerLoop :: TChan String -> IO()
|
|
35 |
timerLoop messagesChan = forever $ do
|
|
36 |
threadDelay (60 * 10^6) -- 60 seconds
|
|
37 |
atomically $ writeTChan messagesChan "MINUTELY"-}
|
|
38 |
|
|
39 |
setupLoggers =
|
|
40 |
updateGlobalLogger "Clients"
|
|
41 |
(setLevel DEBUG)
|
|
42 |
|
|
43 |
main = withSocketsDo $ do
|
|
44 |
#if !defined(mingw32_HOST_OS)
|
|
45 |
installHandler sigPIPE Ignore Nothing;
|
|
46 |
#endif
|
|
47 |
|
|
48 |
setupLoggers
|
|
49 |
|
|
50 |
stats <- atomically $ newTMVar (StatisticsInfo 0 0)
|
|
51 |
--dbQueriesChan <- atomically newTChan
|
|
52 |
coreChan <- newChan
|
|
53 |
serverInfo <- getOpts $ newServerInfo stats -- dbQueriesChan
|
|
54 |
|
|
55 |
bracket
|
|
56 |
(Network.listenOn $ Network.PortNumber $ listenPort serverInfo)
|
|
57 |
(sClose)
|
|
58 |
(startServer serverInfo coreChan)
|