gameServer/hedgewars-server.hs
author Wuzzy <Wuzzy2@mail.ru>
Tue, 02 Apr 2019 00:06:19 +0200
changeset 14759 9423d30ec205
parent 11046 47a8c19ecb60
child 15721 27eb5abd5058
permissions -rw-r--r--
Make team bars 1 pixel higher
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
10460
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10051
diff changeset
     1
{-
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10051
diff changeset
     2
 * Hedgewars, a free turn based strategy game
11046
47a8c19ecb60 more copyright fixes
sheepluva
parents: 10820
diff changeset
     3
 * Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com>
10460
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10051
diff changeset
     4
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10051
diff changeset
     5
 * This program is free software; you can redistribute it and/or modify
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10051
diff changeset
     6
 * it under the terms of the GNU General Public License as published by
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10051
diff changeset
     7
 * the Free Software Foundation; version 2 of the License
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10051
diff changeset
     8
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10051
diff changeset
     9
 * This program is distributed in the hope that it will be useful,
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10051
diff changeset
    10
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10051
diff changeset
    11
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10051
diff changeset
    12
 * GNU General Public License for more details.
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10051
diff changeset
    13
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10051
diff changeset
    14
 * You should have received a copy of the GNU General Public License
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10051
diff changeset
    15
 * along with this program; if not, write to the Free Software
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10051
diff changeset
    16
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10051
diff changeset
    17
 \-}
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10051
diff changeset
    18
4921
2efad3acbb74 Fix build of official server
unc0rr
parents: 4905
diff changeset
    19
{-# LANGUAGE CPP, ScopedTypeVariables, OverloadedStrings #-}
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    20
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    21
module Main where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    22
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4295
diff changeset
    23
import Network.Socket
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4295
diff changeset
    24
import Network.BSD
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    25
import Control.Concurrent.Chan
4960
unc0rr
parents: 4957
diff changeset
    26
import qualified Control.Exception as E
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    27
import System.Log.Logger
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    28
-----------------------------------
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    29
import Opts
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    30
import CoreTypes
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    31
import ServerCore
4991
90d1fb9fc2e1 Fix check for duplicated nickname
unc0rr
parents: 4989
diff changeset
    32
#if defined(OFFICIAL_SERVER)
4974
078cd026a7b1 Add stubs for server config reading and writing routines
unc0rr
parents: 4973
diff changeset
    33
import ConfigFile
4991
90d1fb9fc2e1 Fix check for duplicated nickname
unc0rr
parents: 4989
diff changeset
    34
#endif
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    35
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    36
#if !defined(mingw32_HOST_OS)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    37
import System.Posix
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    38
#endif
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    39
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    40
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4904
diff changeset
    41
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
    42
setupLoggers = do
10820
e86ba0e821a6 Fix bug, undo debug level in server, set air mine number to something non-debug
nemo
parents: 10818
diff changeset
    43
    updateGlobalLogger "Clients" (setLevel NOTICE)
5209
f7a610e2ef5f On restart command close server socket and spawn new server, keep running until last client quits
unc0rr
parents: 5119
diff changeset
    44
    updateGlobalLogger "Core" (setLevel NOTICE)
10051
cc6f62d7aea2 Show which file has failed
unc0rr
parents: 5209
diff changeset
    45
    updateGlobalLogger "REPLAYS" (setLevel NOTICE)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    46
4960
unc0rr
parents: 4957
diff changeset
    47
4989
4771fed9272e - Write server config into .ini file on change
unc0rr
parents: 4982
diff changeset
    48
server :: ServerInfo -> IO ()
4960
unc0rr
parents: 4957
diff changeset
    49
server si = do
unc0rr
parents: 4957
diff changeset
    50
    proto <- getProtocolNumber "tcp"
unc0rr
parents: 4957
diff changeset
    51
    E.bracket
unc0rr
parents: 4957
diff changeset
    52
        (socket AF_INET Stream proto)
unc0rr
parents: 4957
diff changeset
    53
        sClose
unc0rr
parents: 4957
diff changeset
    54
        (\sock -> do
unc0rr
parents: 4957
diff changeset
    55
            setSocketOption sock ReuseAddr 1
unc0rr
parents: 4957
diff changeset
    56
            bindSocket sock (SockAddrInet (listenPort si) iNADDR_ANY)
unc0rr
parents: 4957
diff changeset
    57
            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
    58
            startServer si{serverSocket = Just sock}
4960
unc0rr
parents: 4957
diff changeset
    59
        )
unc0rr
parents: 4957
diff changeset
    60
unc0rr
parents: 4957
diff changeset
    61
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
    62
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
    63
    noticeM "Core" "Shutting down"
4960
unc0rr
parents: 4957
diff changeset
    64
    return ()
unc0rr
parents: 4957
diff changeset
    65
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4904
diff changeset
    66
main :: IO ()
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    67
main = withSocketsDo $ do
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    68
#if !defined(mingw32_HOST_OS)
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    69
    _ <- installHandler sigPIPE Ignore Nothing
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    70
    _ <- installHandler sigCHLD Ignore Nothing
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    71
#endif
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    72
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    73
    setupLoggers
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    74
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    75
    dbQueriesChan <- newChan
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4904
diff changeset
    76
    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
    77
    serverInfo' <- getOpts $ newServerInfo coreChan' dbQueriesChan Nothing Nothing
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4904
diff changeset
    78
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    79
#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
    80
    si <- readServerConfig serverInfo'
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    81
#else
4960
unc0rr
parents: 4957
diff changeset
    82
    let si = serverInfo'
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    83
#endif
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    84
4960
unc0rr
parents: 4957
diff changeset
    85
    (server si) `E.catch` handleRestart