gameServer/hedgewars-server.hs
author nemo
Sun, 24 Jan 2010 16:46:06 +0000
changeset 2712 8f4527c9137c
parent 2349 ba7a0813c532
child 2867 9be6693c78cb
permissions -rw-r--r--
Minor tweak, try to make long flavour text last longer, move the hurt self messages to unused messages group, so they don't get wiped by crate an instant later.
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
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     5
import Network.Socket
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     6
import qualified Network
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     7
import Control.Concurrent.STM
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     8
import Control.Concurrent.Chan
2296
19f2f76dc346 Patch for compiling with 6.10 (define NEW_EXCEPTIONS to do that)
unc0rr
parents: 2129
diff changeset
     9
#if defined(NEW_EXCEPTIONS)
19f2f76dc346 Patch for compiling with 6.10 (define NEW_EXCEPTIONS to do that)
unc0rr
parents: 2129
diff changeset
    10
import qualified Control.OldException as Exception
19f2f76dc346 Patch for compiling with 6.10 (define NEW_EXCEPTIONS to do that)
unc0rr
parents: 2129
diff changeset
    11
#else
19f2f76dc346 Patch for compiling with 6.10 (define NEW_EXCEPTIONS to do that)
unc0rr
parents: 2129
diff changeset
    12
import qualified Control.Exception as Exception
19f2f76dc346 Patch for compiling with 6.10 (define NEW_EXCEPTIONS to do that)
unc0rr
parents: 2129
diff changeset
    13
#endif
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    14
import System.Log.Logger
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    15
-----------------------------------
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    16
import Opts
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    17
import CoreTypes
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    18
import OfficialServer.DBInteraction
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    19
import ServerCore
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    20
import Utils
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    21
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    22
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    23
#if !defined(mingw32_HOST_OS)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    24
import System.Posix
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    25
#endif
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    26
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    27
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    28
setupLoggers =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    29
	updateGlobalLogger "Clients"
1985
0792e1485d07 Less verbose server output
unc0rr
parents: 1964
diff changeset
    30
		(setLevel INFO)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    31
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    32
main = withSocketsDo $ do
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    33
#if !defined(mingw32_HOST_OS)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    34
	installHandler sigPIPE Ignore Nothing;
2129
8664554d5547 Another approach to zombies problem (set SIGCHLD handler to SIG_IGN)
unc0rr
parents: 1985
diff changeset
    35
	installHandler sigCHLD Ignore Nothing;
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    36
#endif
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    37
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    38
	setupLoggers
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    39
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    40
	stats <- atomically $ newTMVar (StatisticsInfo 0 0)
1833
e901ec5644b4 Add options for configuring database access
unc0rr
parents: 1804
diff changeset
    41
	dbQueriesChan <- newChan
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    42
	coreChan <- newChan
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    43
	serverInfo' <- getOpts $ newServerInfo stats coreChan dbQueriesChan
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    44
	
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    45
#if defined(OFFICIAL_SERVER)
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    46
	dbHost' <- askFromConsole "DB host: "
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    47
	dbLogin' <- askFromConsole "login: "
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    48
	dbPassword' <- askFromConsole "password: "
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    49
	let serverInfo = serverInfo'{dbHost = dbHost', dbLogin = dbLogin', dbPassword = dbPassword'}
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    50
#else
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    51
	let serverInfo = serverInfo'
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    52
#endif
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    53
2296
19f2f76dc346 Patch for compiling with 6.10 (define NEW_EXCEPTIONS to do that)
unc0rr
parents: 2129
diff changeset
    54
	Exception.bracket
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    55
		(Network.listenOn $ Network.PortNumber $ listenPort serverInfo)
2349
ba7a0813c532 Some fixes suggested by hlint
unc0rr
parents: 2348
diff changeset
    56
		sClose
1927
e2031906a347 Ping clients every 30 seconds. Disconnection due to ping timeout to be implemented.
unc0rr
parents: 1839
diff changeset
    57
		(startServer serverInfo)