gameServer/hedgewars-server.hs
author nemo
Sun, 20 Jun 2010 22:35:10 -0400
changeset 3526 a1d2180fef42
parent 3500 af8390d807d6
child 3947 709fdb89f76c
permissions -rw-r--r--
Replace SHA1 with adler32. For simple purposes of checking to see if players are playing the same map, this should be quite adequate and runs 15 times faster.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
2348
b39d826e1ccd Drop support for ghc 6.8, use 6.10 instead
unc0rr
parents: 2296
diff changeset
     1
{-# LANGUAGE CPP, ScopedTypeVariables #-}
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
3425
ead2ed20dfd4 Start the server refactoring
unc0rr
parents: 2867
diff changeset
     5
import Network
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     6
import Control.Concurrent.STM
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
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    14
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    15
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    16
#if !defined(mingw32_HOST_OS)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    17
import System.Posix
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    18
#endif
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    19
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    20
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 3425
diff changeset
    21
setupLoggers :: IO ()
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    22
setupLoggers =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    23
    updateGlobalLogger "Clients"
3425
ead2ed20dfd4 Start the server refactoring
unc0rr
parents: 2867
diff changeset
    24
        (setLevel DEBUG)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    25
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 3425
diff changeset
    26
main :: IO ()
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    27
main = withSocketsDo $ do
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    28
#if !defined(mingw32_HOST_OS)
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    29
    installHandler sigPIPE Ignore Nothing;
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    30
    installHandler sigCHLD Ignore Nothing;
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    31
#endif
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    32
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    33
    setupLoggers
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    34
3425
ead2ed20dfd4 Start the server refactoring
unc0rr
parents: 2867
diff changeset
    35
    stats' <- atomically $ newTMVar (StatisticsInfo 0 0)
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    36
    dbQueriesChan <- newChan
3425
ead2ed20dfd4 Start the server refactoring
unc0rr
parents: 2867
diff changeset
    37
    coreChan' <- newChan
ead2ed20dfd4 Start the server refactoring
unc0rr
parents: 2867
diff changeset
    38
    serverInfo' <- getOpts $ newServerInfo stats' coreChan' dbQueriesChan
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 3425
diff changeset
    39
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    40
#if defined(OFFICIAL_SERVER)
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    41
    dbHost' <- askFromConsole "DB host: "
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    42
    dbLogin' <- askFromConsole "login: "
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    43
    dbPassword' <- askFromConsole "password: "
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    44
    let serverInfo = serverInfo'{dbHost = dbHost', dbLogin = dbLogin', dbPassword = dbPassword'}
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    45
#else
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    46
    let serverInfo = serverInfo'
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    47
#endif
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    48
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    49
    Exception.bracket
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    50
        (Network.listenOn $ Network.PortNumber $ listenPort serverInfo)
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    51
        sClose
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    52
        (startServer serverInfo)