gameServer/hedgewars-server.hs
author unc0rr
Thu, 03 Mar 2011 22:15:13 +0300
changeset 4975 31da8979e5b1
parent 4974 078cd026a7b1
child 4982 3572eaf14340
permissions -rw-r--r--
Use Data.TConfig to read and store server config in hedgewars.ini (a little bit of hate to the author for not exporting Conf type)
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
4921
2efad3acbb74 Fix build of official server
unc0rr
parents: 4905
diff changeset
     1
{-# LANGUAGE CPP, ScopedTypeVariables, OverloadedStrings #-}
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
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4295
diff changeset
     5
import Network.Socket
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4295
diff changeset
     6
import Network.BSD
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     7
import Control.Concurrent.Chan
4960
unc0rr
parents: 4957
diff changeset
     8
import qualified Control.Exception as E
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     9
import System.Log.Logger
4962
705c6186ad9d Start new server on RestartException
unc0rr
parents: 4960
diff changeset
    10
import System.Process
4975
31da8979e5b1 Use Data.TConfig to read and store server config in hedgewars.ini (a little bit of hate to the author for not exporting Conf type)
unc0rr
parents: 4974
diff changeset
    11
import Data.TConfig
31da8979e5b1 Use Data.TConfig to read and store server config in hedgewars.ini (a little bit of hate to the author for not exporting Conf type)
unc0rr
parents: 4974
diff changeset
    12
import Data.Maybe
4973
53411a26df7e Add server version (which is separate from protocol version) and a check in frontend for a new enough server (currently only qWarning)
unc0rr
parents: 4968
diff changeset
    13
#if defined(OFFICIAL_SERVER)
4968
8e1673f0dc05 Read server config from file
unc0rr
parents: 4962
diff changeset
    14
import Control.Monad
4973
53411a26df7e Add server version (which is separate from protocol version) and a check in frontend for a new enough server (currently only qWarning)
unc0rr
parents: 4968
diff changeset
    15
#endif
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    16
-----------------------------------
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    17
import Opts
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    18
import CoreTypes
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    19
import ServerCore
4974
078cd026a7b1 Add stubs for server config reading and writing routines
unc0rr
parents: 4973
diff changeset
    20
import ConfigFile
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    21
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    22
#if !defined(mingw32_HOST_OS)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    23
import System.Posix
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    24
#endif
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    25
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    26
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4904
diff changeset
    27
setupLoggers :: IO ()
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    28
setupLoggers =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    29
    updateGlobalLogger "Clients"
3947
709fdb89f76c Some screwing around in try to fix space leak. No luck yet.
unc0rr
parents: 3500
diff changeset
    30
        (setLevel INFO)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    31
4960
unc0rr
parents: 4957
diff changeset
    32
4975
31da8979e5b1 Use Data.TConfig to read and store server config in hedgewars.ini (a little bit of hate to the author for not exporting Conf type)
unc0rr
parents: 4974
diff changeset
    33
server :: ServerInfo c -> IO ()
4960
unc0rr
parents: 4957
diff changeset
    34
server si = do
unc0rr
parents: 4957
diff changeset
    35
    proto <- getProtocolNumber "tcp"
unc0rr
parents: 4957
diff changeset
    36
    E.bracket
unc0rr
parents: 4957
diff changeset
    37
        (socket AF_INET Stream proto)
unc0rr
parents: 4957
diff changeset
    38
        sClose
unc0rr
parents: 4957
diff changeset
    39
        (\sock -> do
unc0rr
parents: 4957
diff changeset
    40
            setSocketOption sock ReuseAddr 1
unc0rr
parents: 4957
diff changeset
    41
            bindSocket sock (SockAddrInet (listenPort si) iNADDR_ANY)
unc0rr
parents: 4957
diff changeset
    42
            listen sock maxListenQueue
unc0rr
parents: 4957
diff changeset
    43
            startServer si sock
unc0rr
parents: 4957
diff changeset
    44
        )
unc0rr
parents: 4957
diff changeset
    45
unc0rr
parents: 4957
diff changeset
    46
handleRestart :: ShutdownException -> IO ()
unc0rr
parents: 4957
diff changeset
    47
handleRestart ShutdownException = return ()
unc0rr
parents: 4957
diff changeset
    48
handleRestart RestartException = do
4962
705c6186ad9d Start new server on RestartException
unc0rr
parents: 4960
diff changeset
    49
    _ <- createProcess (proc "./hedgewars-server" [])
4960
unc0rr
parents: 4957
diff changeset
    50
    return ()
unc0rr
parents: 4957
diff changeset
    51
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4904
diff changeset
    52
main :: IO ()
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    53
main = withSocketsDo $ do
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    54
#if !defined(mingw32_HOST_OS)
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    55
    _ <- installHandler sigPIPE Ignore Nothing
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    56
    _ <- installHandler sigCHLD Ignore Nothing
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    57
#endif
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    58
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    59
    setupLoggers
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    60
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    61
    dbQueriesChan <- newChan
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4904
diff changeset
    62
    coreChan' <- newChan
4975
31da8979e5b1 Use Data.TConfig to read and store server config in hedgewars.ini (a little bit of hate to the author for not exporting Conf type)
unc0rr
parents: 4974
diff changeset
    63
    serverInfo' <- getOpts $ newServerInfo coreChan' dbQueriesChan Nothing
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4904
diff changeset
    64
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    65
#if defined(OFFICIAL_SERVER)
4975
31da8979e5b1 Use Data.TConfig to read and store server config in hedgewars.ini (a little bit of hate to the author for not exporting Conf type)
unc0rr
parents: 4974
diff changeset
    66
    si <- readServerConfig serverInfo'
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    67
#else
4960
unc0rr
parents: 4957
diff changeset
    68
    let si = serverInfo'
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    69
#endif
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    70
4960
unc0rr
parents: 4957
diff changeset
    71
    (server si) `E.catch` handleRestart