gameServer/hedgewars-server.hs
author unc0rr
Wed, 23 Feb 2011 18:38:11 +0300
changeset 4957 3684faf5b3d1
parent 4932 f11d80bac7ed
child 4960 3b54b1c9b768
permissions -rw-r--r--
Remove deprecated statistics MVar
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
4921
2efad3acbb74 Fix build of official server
unc0rr
parents: 4905
diff changeset
     1
{-# LANGUAGE CPP, ScopedTypeVariables, OverloadedStrings #-}
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     2
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     3
module Main where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     4
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4295
diff changeset
     5
import Network.Socket
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4295
diff changeset
     6
import Network.BSD
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     7
import Control.Concurrent.Chan
2296
19f2f76dc346 Patch for compiling with 6.10 (define NEW_EXCEPTIONS to do that)
unc0rr
parents: 2129
diff changeset
     8
import qualified Control.Exception as Exception
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     9
import System.Log.Logger
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
-----------------------------------
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
import Opts
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
import CoreTypes
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
import ServerCore
4921
2efad3acbb74 Fix build of official server
unc0rr
parents: 4905
diff changeset
    14
#if defined(OFFICIAL_SERVER)
2efad3acbb74 Fix build of official server
unc0rr
parents: 4905
diff changeset
    15
import Utils
2efad3acbb74 Fix build of official server
unc0rr
parents: 4905
diff changeset
    16
#endif
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    17
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    18
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    19
#if !defined(mingw32_HOST_OS)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    20
import System.Posix
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    21
#endif
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    22
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    23
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4904
diff changeset
    24
setupLoggers :: IO ()
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    25
setupLoggers =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    26
    updateGlobalLogger "Clients"
3947
709fdb89f76c Some screwing around in try to fix space leak. No luck yet.
unc0rr
parents: 3500
diff changeset
    27
        (setLevel INFO)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    28
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4904
diff changeset
    29
main :: IO ()
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    30
main = withSocketsDo $ do
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    31
#if !defined(mingw32_HOST_OS)
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    32
    _ <- installHandler sigPIPE Ignore Nothing
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    33
    _ <- installHandler sigCHLD Ignore Nothing
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    34
#endif
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    35
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    36
    setupLoggers
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    37
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    38
    dbQueriesChan <- newChan
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4904
diff changeset
    39
    coreChan' <- newChan
4957
3684faf5b3d1 Remove deprecated statistics MVar
unc0rr
parents: 4932
diff changeset
    40
    serverInfo' <- getOpts $ newServerInfo coreChan' dbQueriesChan
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4904
diff changeset
    41
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    42
#if defined(OFFICIAL_SERVER)
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    43
    dbHost' <- askFromConsole "DB host: "
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    44
    dbLogin' <- askFromConsole "login: "
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    45
    dbPassword' <- askFromConsole "password: "
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    46
    let serverInfo = serverInfo'{dbHost = dbHost', dbLogin = dbLogin', dbPassword = dbPassword'}
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    47
#else
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    48
    let serverInfo = serverInfo'
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    49
#endif
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    50
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4295
diff changeset
    51
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4295
diff changeset
    52
    proto <- getProtocolNumber "tcp"
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    53
    Exception.bracket
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4295
diff changeset
    54
        (socket AF_INET Stream proto)
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    55
        sClose
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4295
diff changeset
    56
        (\sock -> do
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4295
diff changeset
    57
            setSocketOption sock ReuseAddr 1
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4295
diff changeset
    58
            bindSocket sock (SockAddrInet (listenPort serverInfo) iNADDR_ANY)
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4295
diff changeset
    59
            listen sock maxListenQueue
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4295
diff changeset
    60
            startServer serverInfo sock
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4295
diff changeset
    61
        )