gameServer/hedgewars-server.hs
author unc0rr
Fri, 01 May 2009 09:01:44 +0000
changeset 2021 a591afb43768
parent 1985 0792e1485d07
child 2129 8664554d5547
permissions -rw-r--r--
Some changes in try to fix issue when you enter room with painted map, but frontend shows generated one (most probably bug is triggered by template filters) Untested.
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;
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    31
#endif
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    32
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    33
	setupLoggers
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    34
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    35
	stats <- atomically $ newTMVar (StatisticsInfo 0 0)
1833
e901ec5644b4 Add options for configuring database access
unc0rr
parents: 1804
diff changeset
    36
	dbQueriesChan <- newChan
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    37
	coreChan <- newChan
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    38
	serverInfo' <- getOpts $ newServerInfo stats coreChan dbQueriesChan
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    39
	
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    40
#if defined(OFFICIAL_SERVER)
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    41
	dbHost' <- askFromConsole "DB host: "
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    42
	dbLogin' <- askFromConsole "login: "
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    43
	dbPassword' <- askFromConsole "password: "
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    44
	let serverInfo = serverInfo'{dbHost = dbHost', dbLogin = dbLogin', dbPassword = dbPassword'}
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    45
#else
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    46
	let serverInfo = serverInfo'
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
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    49
	bracket
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    50
		(Network.listenOn $ Network.PortNumber $ listenPort serverInfo)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    51
		(sClose)
1927
e2031906a347 Ping clients every 30 seconds. Disconnection due to ping timeout to be implemented.
unc0rr
parents: 1839
diff changeset
    52
		(startServer serverInfo)