gameServer/hedgewars-server.hs
author smaxx
Fri, 10 Sep 2010 20:46:19 +0200
changeset 3848 32ceb775906b
parent 3500 af8390d807d6
child 3947 709fdb89f76c
permissions -rw-r--r--
Engine: * Added new script call: OnGearDamage(GearID : integer, Damage : integer) - triggered once gears are damaged * Renamed script call: OnResurrect is now called OnGearResurrect * Added new script functions: CampaignLock(key : string), CampaignUnlock(key : string) - toggles for (not yet implemented) campaign access and progress flags

{-# LANGUAGE CPP, ScopedTypeVariables #-}

module Main where

import Network
import Control.Concurrent.STM
import Control.Concurrent.Chan
import qualified Control.Exception as Exception
import System.Log.Logger
-----------------------------------
import Opts
import CoreTypes
import ServerCore


#if !defined(mingw32_HOST_OS)
import System.Posix
#endif


setupLoggers :: IO ()
setupLoggers =
    updateGlobalLogger "Clients"
        (setLevel DEBUG)

main :: IO ()
main = withSocketsDo $ do
#if !defined(mingw32_HOST_OS)
    installHandler sigPIPE Ignore Nothing;
    installHandler sigCHLD Ignore Nothing;
#endif

    setupLoggers

    stats' <- atomically $ newTMVar (StatisticsInfo 0 0)
    dbQueriesChan <- newChan
    coreChan' <- newChan
    serverInfo' <- getOpts $ newServerInfo stats' coreChan' dbQueriesChan

#if defined(OFFICIAL_SERVER)
    dbHost' <- askFromConsole "DB host: "
    dbLogin' <- askFromConsole "login: "
    dbPassword' <- askFromConsole "password: "
    let serverInfo = serverInfo'{dbHost = dbHost', dbLogin = dbLogin', dbPassword = dbPassword'}
#else
    let serverInfo = serverInfo'
#endif

    Exception.bracket
        (Network.listenOn $ Network.PortNumber $ listenPort serverInfo)
        sClose
        (startServer serverInfo)