1 {-# LANGUAGE CPP, ScopedTypeVariables #-} |
1 {-# LANGUAGE CPP, ScopedTypeVariables #-} |
2 |
2 |
3 module Main where |
3 module Main where |
4 |
4 |
5 import Network |
5 import Network.Socket |
|
6 import qualified Network |
|
7 import Network.BSD |
6 import Control.Concurrent.STM |
8 import Control.Concurrent.STM |
7 import Control.Concurrent.Chan |
9 import Control.Concurrent.Chan |
|
10 #if defined(NEW_EXCEPTIONS) |
|
11 import qualified Control.OldException as Exception |
|
12 #else |
8 import qualified Control.Exception as Exception |
13 import qualified Control.Exception as Exception |
|
14 #endif |
9 import System.Log.Logger |
15 import System.Log.Logger |
10 ----------------------------------- |
16 ----------------------------------- |
11 import Opts |
17 import Opts |
12 import CoreTypes |
18 import CoreTypes |
|
19 import OfficialServer.DBInteraction |
13 import ServerCore |
20 import ServerCore |
|
21 import Utils |
14 |
22 |
15 |
23 |
16 #if !defined(mingw32_HOST_OS) |
24 #if !defined(mingw32_HOST_OS) |
17 import System.Posix |
25 import System.Posix |
18 #endif |
26 #endif |
19 |
27 |
20 |
28 |
21 setupLoggers :: IO () |
|
22 setupLoggers = |
29 setupLoggers = |
23 updateGlobalLogger "Clients" |
30 updateGlobalLogger "Clients" |
24 (setLevel INFO) |
31 (setLevel INFO) |
25 |
32 |
26 main :: IO () |
|
27 main = withSocketsDo $ do |
33 main = withSocketsDo $ do |
28 #if !defined(mingw32_HOST_OS) |
34 #if !defined(mingw32_HOST_OS) |
29 installHandler sigPIPE Ignore Nothing; |
35 installHandler sigPIPE Ignore Nothing; |
30 installHandler sigCHLD Ignore Nothing; |
36 installHandler sigCHLD Ignore Nothing; |
31 #endif |
37 #endif |
32 |
38 |
33 setupLoggers |
39 setupLoggers |
34 |
40 |
35 stats' <- atomically $ newTMVar (StatisticsInfo 0 0) |
41 stats <- atomically $ newTMVar (StatisticsInfo 0 0) |
36 dbQueriesChan <- newChan |
42 dbQueriesChan <- newChan |
37 coreChan' <- newChan |
43 coreChan <- newChan |
38 serverInfo' <- getOpts $ newServerInfo stats' coreChan' dbQueriesChan |
44 serverInfo' <- getOpts $ newServerInfo stats coreChan dbQueriesChan |
39 |
45 |
40 #if defined(OFFICIAL_SERVER) |
46 #if defined(OFFICIAL_SERVER) |
41 dbHost' <- askFromConsole "DB host: " |
47 dbHost' <- askFromConsole "DB host: " |
42 dbLogin' <- askFromConsole "login: " |
48 dbLogin' <- askFromConsole "login: " |
43 dbPassword' <- askFromConsole "password: " |
49 dbPassword' <- askFromConsole "password: " |
44 let serverInfo = serverInfo'{dbHost = dbHost', dbLogin = dbLogin', dbPassword = dbPassword'} |
50 let serverInfo = serverInfo'{dbHost = dbHost', dbLogin = dbLogin', dbPassword = dbPassword'} |
45 #else |
51 #else |
46 let serverInfo = serverInfo' |
52 let serverInfo = serverInfo' |
47 #endif |
53 #endif |
48 |
54 |
|
55 |
|
56 proto <- getProtocolNumber "tcp" |
49 Exception.bracket |
57 Exception.bracket |
50 (Network.listenOn $ Network.PortNumber $ listenPort serverInfo) |
58 (socket AF_INET Stream proto) |
51 sClose |
59 sClose |
52 (startServer serverInfo) |
60 (\sock -> do |
|
61 setSocketOption sock ReuseAddr 1 |
|
62 bindSocket sock (SockAddrInet (listenPort serverInfo) iNADDR_ANY) |
|
63 listen sock maxListenQueue |
|
64 startServer serverInfo sock |
|
65 ) |