gameServer/hedgewars-server.hs
author sheepluva
Thu, 23 Jan 2014 13:56:53 +0100
changeset 10061 b7161f00a6ca
parent 10051 cc6f62d7aea2
child 10460 8dcea9087d75
permissions -rw-r--r--
hide complete IP of other users, when non-admin requests player info. showing the first two parts of the IP was kinda pointless to begin with (what for?) and has recently lead to increased abuse and lobby flooding due to bots collecting/posting IP tracking information
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
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
-----------------------------------
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
import Opts
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
import CoreTypes
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
import ServerCore
4991
90d1fb9fc2e1 Fix check for duplicated nickname
unc0rr
parents: 4989
diff changeset
    14
#if defined(OFFICIAL_SERVER)
4974
078cd026a7b1 Add stubs for server config reading and writing routines
unc0rr
parents: 4973
diff changeset
    15
import ConfigFile
4991
90d1fb9fc2e1 Fix check for duplicated nickname
unc0rr
parents: 4989
diff changeset
    16
#endif
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    17
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    18
#if !defined(mingw32_HOST_OS)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    19
import System.Posix
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    20
#endif
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    21
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    22
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4904
diff changeset
    23
setupLoggers :: IO ()
5209
f7a610e2ef5f On restart command close server socket and spawn new server, keep running until last client quits
unc0rr
parents: 5119
diff changeset
    24
setupLoggers = do
f7a610e2ef5f On restart command close server socket and spawn new server, keep running until last client quits
unc0rr
parents: 5119
diff changeset
    25
    updateGlobalLogger "Clients" (setLevel NOTICE)
f7a610e2ef5f On restart command close server socket and spawn new server, keep running until last client quits
unc0rr
parents: 5119
diff changeset
    26
    updateGlobalLogger "Core" (setLevel NOTICE)
10051
cc6f62d7aea2 Show which file has failed
unc0rr
parents: 5209
diff changeset
    27
    updateGlobalLogger "REPLAYS" (setLevel NOTICE)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    28
4960
unc0rr
parents: 4957
diff changeset
    29
4989
4771fed9272e - Write server config into .ini file on change
unc0rr
parents: 4982
diff changeset
    30
server :: ServerInfo -> IO ()
4960
unc0rr
parents: 4957
diff changeset
    31
server si = do
unc0rr
parents: 4957
diff changeset
    32
    proto <- getProtocolNumber "tcp"
unc0rr
parents: 4957
diff changeset
    33
    E.bracket
unc0rr
parents: 4957
diff changeset
    34
        (socket AF_INET Stream proto)
unc0rr
parents: 4957
diff changeset
    35
        sClose
unc0rr
parents: 4957
diff changeset
    36
        (\sock -> do
unc0rr
parents: 4957
diff changeset
    37
            setSocketOption sock ReuseAddr 1
unc0rr
parents: 4957
diff changeset
    38
            bindSocket sock (SockAddrInet (listenPort si) iNADDR_ANY)
unc0rr
parents: 4957
diff changeset
    39
            listen sock maxListenQueue
5209
f7a610e2ef5f On restart command close server socket and spawn new server, keep running until last client quits
unc0rr
parents: 5119
diff changeset
    40
            startServer si{serverSocket = Just sock}
4960
unc0rr
parents: 4957
diff changeset
    41
        )
unc0rr
parents: 4957
diff changeset
    42
unc0rr
parents: 4957
diff changeset
    43
handleRestart :: ShutdownException -> IO ()
5209
f7a610e2ef5f On restart command close server socket and spawn new server, keep running until last client quits
unc0rr
parents: 5119
diff changeset
    44
handleRestart ShutdownException = do
f7a610e2ef5f On restart command close server socket and spawn new server, keep running until last client quits
unc0rr
parents: 5119
diff changeset
    45
    noticeM "Core" "Shutting down"
4960
unc0rr
parents: 4957
diff changeset
    46
    return ()
unc0rr
parents: 4957
diff changeset
    47
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4904
diff changeset
    48
main :: IO ()
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    49
main = withSocketsDo $ do
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    50
#if !defined(mingw32_HOST_OS)
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    51
    _ <- installHandler sigPIPE Ignore Nothing
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    52
    _ <- installHandler sigCHLD Ignore Nothing
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    53
#endif
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    54
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    55
    setupLoggers
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    56
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    57
    dbQueriesChan <- newChan
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4904
diff changeset
    58
    coreChan' <- newChan
5209
f7a610e2ef5f On restart command close server socket and spawn new server, keep running until last client quits
unc0rr
parents: 5119
diff changeset
    59
    serverInfo' <- getOpts $ newServerInfo coreChan' dbQueriesChan Nothing Nothing
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4904
diff changeset
    60
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    61
#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
    62
    si <- readServerConfig serverInfo'
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    63
#else
4960
unc0rr
parents: 4957
diff changeset
    64
    let si = serverInfo'
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    65
#endif
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    66
4960
unc0rr
parents: 4957
diff changeset
    67
    (server si) `E.catch` handleRestart