gameServer/hedgewars-server.hs
author unc0rr
Sun, 06 Mar 2011 21:54:37 +0300
changeset 4989 4771fed9272e
parent 4982 3572eaf14340
child 4991 90d1fb9fc2e1
permissions -rw-r--r--
- Write server config into .ini file on change - Import Data.TConfig into project, make it export Conf constructor, remove all workarounds for missing constructor in server.
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
1804
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 ServerCore
4974
078cd026a7b1 Add stubs for server config reading and writing routines
unc0rr
parents: 4973
diff changeset
    15
import ConfigFile
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    16
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    17
#if !defined(mingw32_HOST_OS)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    18
import System.Posix
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    19
#endif
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    20
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    21
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4904
diff changeset
    22
setupLoggers :: IO ()
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    23
setupLoggers =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    24
    updateGlobalLogger "Clients"
3947
709fdb89f76c Some screwing around in try to fix space leak. No luck yet.
unc0rr
parents: 3500
diff changeset
    25
        (setLevel INFO)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    26
4960
unc0rr
parents: 4957
diff changeset
    27
4989
4771fed9272e - Write server config into .ini file on change
unc0rr
parents: 4982
diff changeset
    28
server :: ServerInfo -> IO ()
4960
unc0rr
parents: 4957
diff changeset
    29
server si = do
unc0rr
parents: 4957
diff changeset
    30
    proto <- getProtocolNumber "tcp"
unc0rr
parents: 4957
diff changeset
    31
    E.bracket
unc0rr
parents: 4957
diff changeset
    32
        (socket AF_INET Stream proto)
unc0rr
parents: 4957
diff changeset
    33
        sClose
unc0rr
parents: 4957
diff changeset
    34
        (\sock -> do
unc0rr
parents: 4957
diff changeset
    35
            setSocketOption sock ReuseAddr 1
unc0rr
parents: 4957
diff changeset
    36
            bindSocket sock (SockAddrInet (listenPort si) iNADDR_ANY)
unc0rr
parents: 4957
diff changeset
    37
            listen sock maxListenQueue
unc0rr
parents: 4957
diff changeset
    38
            startServer si sock
unc0rr
parents: 4957
diff changeset
    39
        )
unc0rr
parents: 4957
diff changeset
    40
unc0rr
parents: 4957
diff changeset
    41
handleRestart :: ShutdownException -> IO ()
unc0rr
parents: 4957
diff changeset
    42
handleRestart ShutdownException = return ()
unc0rr
parents: 4957
diff changeset
    43
handleRestart RestartException = do
4962
705c6186ad9d Start new server on RestartException
unc0rr
parents: 4960
diff changeset
    44
    _ <- createProcess (proc "./hedgewars-server" [])
4960
unc0rr
parents: 4957
diff changeset
    45
    return ()
unc0rr
parents: 4957
diff changeset
    46
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4904
diff changeset
    47
main :: IO ()
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    48
main = withSocketsDo $ do
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    49
#if !defined(mingw32_HOST_OS)
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    50
    _ <- installHandler sigPIPE Ignore Nothing
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    51
    _ <- installHandler sigCHLD Ignore Nothing
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    52
#endif
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    53
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    54
    setupLoggers
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    55
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    56
    dbQueriesChan <- newChan
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4904
diff changeset
    57
    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
    58
    serverInfo' <- getOpts $ newServerInfo coreChan' dbQueriesChan Nothing
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4904
diff changeset
    59
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    60
#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
    61
    si <- readServerConfig serverInfo'
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    62
#else
4960
unc0rr
parents: 4957
diff changeset
    63
    let si = serverInfo'
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    64
#endif
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    65
4960
unc0rr
parents: 4957
diff changeset
    66
    (server si) `E.catch` handleRestart