gameServer/hedgewars-server.hs
author nemo
Mon, 20 Jul 2009 19:04:10 +0000
changeset 2267 ad372e549cc5
parent 2129 8664554d5547
child 2296 19f2f76dc346
permissions -rw-r--r--
Restrict hogs to 16px proximity to border to avoid getting kicked through.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     1
{-# LANGUAGE CPP, ScopedTypeVariables, PatternSignatures #-}
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
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     9
import Control.Exception
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
import System.Log.Logger
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
-----------------------------------
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
import Opts
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
import CoreTypes
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    14
import OfficialServer.DBInteraction
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    15
import ServerCore
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    16
import Utils
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
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    24
setupLoggers =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    25
	updateGlobalLogger "Clients"
1985
0792e1485d07 Less verbose server output
unc0rr
parents: 1964
diff changeset
    26
		(setLevel INFO)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    27
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    28
main = withSocketsDo $ do
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    29
#if !defined(mingw32_HOST_OS)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    30
	installHandler sigPIPE Ignore Nothing;
2129
8664554d5547 Another approach to zombies problem (set SIGCHLD handler to SIG_IGN)
unc0rr
parents: 1985
diff changeset
    31
	installHandler sigCHLD Ignore Nothing;
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    32
#endif
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    33
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    34
	setupLoggers
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    35
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    36
	stats <- atomically $ newTMVar (StatisticsInfo 0 0)
1833
e901ec5644b4 Add options for configuring database access
unc0rr
parents: 1804
diff changeset
    37
	dbQueriesChan <- newChan
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    38
	coreChan <- newChan
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    39
	serverInfo' <- getOpts $ newServerInfo stats coreChan dbQueriesChan
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    40
	
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    41
#if defined(OFFICIAL_SERVER)
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    42
	dbHost' <- askFromConsole "DB host: "
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    43
	dbLogin' <- askFromConsole "login: "
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    44
	dbPassword' <- askFromConsole "password: "
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    45
	let serverInfo = serverInfo'{dbHost = dbHost', dbLogin = dbLogin', dbPassword = dbPassword'}
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    46
#else
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    47
	let serverInfo = serverInfo'
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    48
#endif
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    49
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    50
	bracket
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    51
		(Network.listenOn $ Network.PortNumber $ listenPort serverInfo)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    52
		(sClose)
1927
e2031906a347 Ping clients every 30 seconds. Disconnection due to ping timeout to be implemented.
unc0rr
parents: 1839
diff changeset
    53
		(startServer serverInfo)