gameServer/stresstest.hs
author S.D.
Tue, 27 Sep 2022 14:59:03 +0300
changeset 15878 fc3cb23fd26f
parent 11046 47a8c19ecb60
permissions -rw-r--r--
Allow to see rooms of incompatible versions in the lobby For the new clients the room version is shown in a separate column. There is also a hack for previous versions clients: the room vesion specifier is prepended to the room names for rooms of incompatible versions, and the server shows 'incompatible version' error if the client tries to join them.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
10460
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 6805
diff changeset
     1
{-
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 6805
diff changeset
     2
 * Hedgewars, a free turn based strategy game
11046
47a8c19ecb60 more copyright fixes
sheepluva
parents: 10460
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: 6805
diff changeset
     4
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 6805
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: 6805
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: 6805
diff changeset
     7
 * the Free Software Foundation; version 2 of the License
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 6805
diff changeset
     8
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 6805
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: 6805
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: 6805
diff changeset
    11
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 6805
diff changeset
    12
 * GNU General Public License for more details.
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 6805
diff changeset
    13
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 6805
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: 6805
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: 6805
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: 6805
diff changeset
    17
 \-}
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 6805
diff changeset
    18
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    19
{-# LANGUAGE CPP #-}
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
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    23
import System.IO
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4905
diff changeset
    24
import System.IO.Error
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    25
import Control.Concurrent
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    26
import Network
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    27
import Control.OldException
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    28
import Control.Monad
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    29
import System.Random
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    30
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    31
#if !defined(mingw32_HOST_OS)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    32
import System.Posix
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    33
#endif
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    34
6805
097289be7200 Add more strictness in hope it will help with space leak
unc0rr
parents: 5119
diff changeset
    35
session 0 nick room = ["NICK", nick, "", "PROTO", "42", "", "PING", "", "CHAT", "lobby 1", "", "PONG", "", "CREATE_ROOM", room, "", "CHAT", "room 1", "", "QUIT", "creator", ""]
097289be7200 Add more strictness in hope it will help with space leak
unc0rr
parents: 5119
diff changeset
    36
session 1 nick room = ["NICK", nick, "", "PROTO", "42", "", "LIST", "", "JOIN_ROOM", room, "", "PONG", "", "CHAT", "room 2", "", "PART", "", "CHAT", "lobby after part", "", "QUIT", "part-quit", ""]
097289be7200 Add more strictness in hope it will help with space leak
unc0rr
parents: 5119
diff changeset
    37
session 2 nick room = ["NICK", nick, "", "PROTO", "42", "", "LIST", "", "JOIN_ROOM", room, "", "PONG", "", "CHAT", "room 2", "", "QUIT", "quit", ""]
097289be7200 Add more strictness in hope it will help with space leak
unc0rr
parents: 5119
diff changeset
    38
session 3 nick room = ["NICK", nick, "", "PROTO", "42", "", "CHAT", "lobby 1", "", "CREATE_ROOM", room, "", "", "PONG", "CHAT", "room 1", "", "PART", "creator", "", "QUIT", "part-quit", ""]
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    39
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    40
emulateSession sock s = do
5119
f475e10c4081 Fix crash in server (accessing deleted room)
unc0rr
parents: 5077
diff changeset
    41
    mapM_ (\x -> hPutStrLn sock x >> hFlush sock >> randomRIO (100000::Int, 600000) >>= threadDelay) s
2948
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
diff changeset
    42
    hFlush sock
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
diff changeset
    43
    threadDelay 225000
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    44
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    45
testing = Control.OldException.handle print $ do
2948
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
diff changeset
    46
    putStrLn "Start"
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
diff changeset
    47
    sock <- connectTo "127.0.0.1" (PortNumber 46631)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    48
5119
f475e10c4081 Fix crash in server (accessing deleted room)
unc0rr
parents: 5077
diff changeset
    49
    num1 <- randomRIO (100000::Int, 101000)
f475e10c4081 Fix crash in server (accessing deleted room)
unc0rr
parents: 5077
diff changeset
    50
    num2 <- randomRIO (0::Int, 3)
f475e10c4081 Fix crash in server (accessing deleted room)
unc0rr
parents: 5077
diff changeset
    51
    num3 <- randomRIO (0::Int, 1000)
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    52
    let nick1 = 'n' : show num1
5119
f475e10c4081 Fix crash in server (accessing deleted room)
unc0rr
parents: 5077
diff changeset
    53
    let room1 = 'r' : show num3
f475e10c4081 Fix crash in server (accessing deleted room)
unc0rr
parents: 5077
diff changeset
    54
    emulateSession sock $ session num2 nick1 room1
2948
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
diff changeset
    55
    hClose sock
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
diff changeset
    56
    putStrLn "Finish"
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    57
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    58
forks = forever $ do
5119
f475e10c4081 Fix crash in server (accessing deleted room)
unc0rr
parents: 5077
diff changeset
    59
    delays <- randomRIO (0::Int, 2)
f475e10c4081 Fix crash in server (accessing deleted room)
unc0rr
parents: 5077
diff changeset
    60
    replicateM 200 $
f475e10c4081 Fix crash in server (accessing deleted room)
unc0rr
parents: 5077
diff changeset
    61
        do
f475e10c4081 Fix crash in server (accessing deleted room)
unc0rr
parents: 5077
diff changeset
    62
        delay <- randomRIO (delays * 20000::Int, delays * 20000 + 50000)
f475e10c4081 Fix crash in server (accessing deleted room)
unc0rr
parents: 5077
diff changeset
    63
        threadDelay delay
f475e10c4081 Fix crash in server (accessing deleted room)
unc0rr
parents: 5077
diff changeset
    64
        forkIO testing
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    65
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    66
main = withSocketsDo $ do
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    67
#if !defined(mingw32_HOST_OS)
2948
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
diff changeset
    68
    installHandler sigPIPE Ignore Nothing;
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    69
#endif
2948
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
diff changeset
    70
    forks