gameServer/FloodDetection.hs
author S.D.
Tue, 27 Sep 2022 14:59:03 +0300
changeset 15878 fc3cb23fd26f
parent 14841 111c4d750c6d
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:
10464
d08611b52000 Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10095
diff changeset
     1
{-
d08611b52000 Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10095
diff changeset
     2
 * Hedgewars, a free turn based strategy game
11046
47a8c19ecb60 more copyright fixes
sheepluva
parents: 10464
diff changeset
     3
 * Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com>
10464
d08611b52000 Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10095
diff changeset
     4
 *
d08611b52000 Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10095
diff changeset
     5
 * This program is free software; you can redistribute it and/or modify
d08611b52000 Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10095
diff changeset
     6
 * it under the terms of the GNU General Public License as published by
d08611b52000 Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10095
diff changeset
     7
 * the Free Software Foundation; version 2 of the License
d08611b52000 Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10095
diff changeset
     8
 *
d08611b52000 Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10095
diff changeset
     9
 * This program is distributed in the hope that it will be useful,
d08611b52000 Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10095
diff changeset
    10
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
d08611b52000 Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10095
diff changeset
    11
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
d08611b52000 Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10095
diff changeset
    12
 * GNU General Public License for more details.
d08611b52000 Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10095
diff changeset
    13
 *
d08611b52000 Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10095
diff changeset
    14
 * You should have received a copy of the GNU General Public License
d08611b52000 Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10095
diff changeset
    15
 * along with this program; if not, write to the Free Software
d08611b52000 Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10095
diff changeset
    16
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
d08611b52000 Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10095
diff changeset
    17
 \-}
d08611b52000 Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10095
diff changeset
    18
10095
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    19
{-# LANGUAGE OverloadedStrings, BangPatterns #-}
10090
a471a7bbc339 - Start work on flood detector
unc0rr
parents:
diff changeset
    20
module FloodDetection where
a471a7bbc339 - Start work on flood detector
unc0rr
parents:
diff changeset
    21
10093
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    22
import Control.Monad.State.Strict
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    23
import Data.Time
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    24
import Control.Arrow
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    25
----------------
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    26
import ServerState
10090
a471a7bbc339 - Start work on flood detector
unc0rr
parents:
diff changeset
    27
import CoreTypes
10095
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    28
import Utils
10090
a471a7bbc339 - Start work on flood detector
unc0rr
parents:
diff changeset
    29
10093
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    30
registerEvent :: Event -> StateT ServerState IO [Action]
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    31
registerEvent e = do
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    32
    eventInfo <- client's $ einfo e
10094
d3a2fe9f04f2 Define some boundaries to detect events
unc0rr
parents: 10093
diff changeset
    33
    if (null eventInfo) || 0 == (fst $ head eventInfo) then doCheck eventInfo else updateInfo
10095
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    34
10093
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    35
    where
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    36
    einfo LobbyChatMessage = eiLobbyChat
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    37
    einfo EngineMessage = eiEM
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    38
    einfo RoomJoin = eiJoin
14841
111c4d750c6d Limit room name change rate
unc0rr
parents: 11466
diff changeset
    39
    einfo RoomNameUpdate = eiLobbyChat
10094
d3a2fe9f04f2 Define some boundaries to detect events
unc0rr
parents: 10093
diff changeset
    40
10093
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    41
    transformField LobbyChatMessage f = \c -> c{eiLobbyChat = f $ eiLobbyChat c}
10095
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    42
    transformField EngineMessage f = \c -> c{eiEM = f $ eiEM c}
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    43
    transformField RoomJoin f = \c -> c{eiJoin = f $ eiJoin c}
14841
111c4d750c6d Limit room name change rate
unc0rr
parents: 11466
diff changeset
    44
    transformField RoomNameUpdate f = transformField LobbyChatMessage f
111c4d750c6d Limit room name change rate
unc0rr
parents: 11466
diff changeset
    45
    
10094
d3a2fe9f04f2 Define some boundaries to detect events
unc0rr
parents: 10093
diff changeset
    46
10095
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    47
    boundaries :: Event -> (Int, (NominalDiffTime, Int), (NominalDiffTime, Int), ([Action], [Action]))
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    48
    boundaries LobbyChatMessage = (3, (10, 2), (30, 3), (chat1, chat2))
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    49
    boundaries EngineMessage = (8, (10, 4), (25, 5), (em1, em2))
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    50
    boundaries RoomJoin = (2, (10, 2), (35, 3), (join1, join2))
14841
111c4d750c6d Limit room name change rate
unc0rr
parents: 11466
diff changeset
    51
    boundaries RoomNameUpdate = (\(a, b, c, _) -> (a, b, c, (roomName1, roomName2))) $ boundaries LobbyChatMessage
10095
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    52
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    53
    chat1 = [Warning $ loc "Warning! Chat flood protection activated"]
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    54
    chat2 = [ByeClient $ loc "Excess flood"]
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    55
    em1 = [Warning $ loc "Game messages flood detected - 1"]
11466
4b5c7a5c49fd Defer kicking to the time when everything is in consistent state
unc0rr
parents: 11046
diff changeset
    56
    em2 = [ByeClient $ loc "Excess flood"]
10095
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    57
    join1 = [Warning $ loc "Warning! Joins flood protection activated"]
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    58
    join2 = [ByeClient $ loc "Excess flood"]
14841
111c4d750c6d Limit room name change rate
unc0rr
parents: 11466
diff changeset
    59
    roomName1 = [Warning $ loc "Warning! Room name change flood protection activated"]
111c4d750c6d Limit room name change rate
unc0rr
parents: 11466
diff changeset
    60
    roomName2 = [ByeClient $ loc "Excess flood"]
10094
d3a2fe9f04f2 Define some boundaries to detect events
unc0rr
parents: 10093
diff changeset
    61
10093
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    62
    doCheck ei = do
10094
d3a2fe9f04f2 Define some boundaries to detect events
unc0rr
parents: 10093
diff changeset
    63
        curTime <- io getCurrentTime
10095
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    64
        let (numPerEntry, (sec1, num1), (sec2, num2), (ac1, ac2)) = boundaries e
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    65
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    66
        let nei = takeWhile ((>=) sec2 . diffUTCTime curTime . snd) ei
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    67
        let l2 = length nei
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    68
        let l1 = length $ takeWhile ((>=) sec1 . diffUTCTime curTime . snd) nei
10094
d3a2fe9f04f2 Define some boundaries to detect events
unc0rr
parents: 10093
diff changeset
    69
10095
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    70
        let actions = if l2 >= num2 + 1 || l1 >= num1 + 1 then 
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    71
                ac2
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    72
                else
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    73
                if l1 >= num1 || l2 >= num2 then 
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    74
                    ac1
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    75
                    else
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    76
                    []
10094
d3a2fe9f04f2 Define some boundaries to detect events
unc0rr
parents: 10093
diff changeset
    77
11466
4b5c7a5c49fd Defer kicking to the time when everything is in consistent state
unc0rr
parents: 11046
diff changeset
    78
        return $ [ModifyClient . transformField e . const $ (numPerEntry, curTime) : nei
4b5c7a5c49fd Defer kicking to the time when everything is in consistent state
unc0rr
parents: 11046
diff changeset
    79
                , ModifyClient (\c -> c{pendingActions = actions}) -- append? prepend? just replacing for now
4b5c7a5c49fd Defer kicking to the time when everything is in consistent state
unc0rr
parents: 11046
diff changeset
    80
            ]
10094
d3a2fe9f04f2 Define some boundaries to detect events
unc0rr
parents: 10093
diff changeset
    81
10093
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    82
    updateInfo = return [
10094
d3a2fe9f04f2 Define some boundaries to detect events
unc0rr
parents: 10093
diff changeset
    83
        ModifyClient $ transformField e
d3a2fe9f04f2 Define some boundaries to detect events
unc0rr
parents: 10093
diff changeset
    84
            $ \(h:hs) -> first (flip (-) 1) h : hs
10093
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    85
        ]