author | unc0rr |
Sat, 03 Nov 2018 00:02:03 +0100 | |
changeset 14103 | 8556937ae338 |
parent 11466 | 4b5c7a5c49fd |
child 14841 | 111c4d750c6d |
permissions | -rw-r--r-- |
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 | 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 | 19 |
{-# LANGUAGE OverloadedStrings, BangPatterns #-} |
10090 | 20 |
module FloodDetection where |
21 |
||
10093 | 22 |
import Control.Monad.State.Strict |
23 |
import Data.Time |
|
24 |
import Control.Arrow |
|
25 |
---------------- |
|
26 |
import ServerState |
|
10090 | 27 |
import CoreTypes |
10095 | 28 |
import Utils |
10090 | 29 |
|
10093 | 30 |
registerEvent :: Event -> StateT ServerState IO [Action] |
31 |
registerEvent e = do |
|
32 |
eventInfo <- client's $ einfo e |
|
10094 | 33 |
if (null eventInfo) || 0 == (fst $ head eventInfo) then doCheck eventInfo else updateInfo |
10095 | 34 |
|
10093 | 35 |
where |
36 |
einfo LobbyChatMessage = eiLobbyChat |
|
37 |
einfo EngineMessage = eiEM |
|
38 |
einfo RoomJoin = eiJoin |
|
10094 | 39 |
|
10093 | 40 |
transformField LobbyChatMessage f = \c -> c{eiLobbyChat = f $ eiLobbyChat c} |
10095 | 41 |
transformField EngineMessage f = \c -> c{eiEM = f $ eiEM c} |
42 |
transformField RoomJoin f = \c -> c{eiJoin = f $ eiJoin c} |
|
10094 | 43 |
|
10095 | 44 |
boundaries :: Event -> (Int, (NominalDiffTime, Int), (NominalDiffTime, Int), ([Action], [Action])) |
45 |
boundaries LobbyChatMessage = (3, (10, 2), (30, 3), (chat1, chat2)) |
|
46 |
boundaries EngineMessage = (8, (10, 4), (25, 5), (em1, em2)) |
|
47 |
boundaries RoomJoin = (2, (10, 2), (35, 3), (join1, join2)) |
|
48 |
||
49 |
chat1 = [Warning $ loc "Warning! Chat flood protection activated"] |
|
50 |
chat2 = [ByeClient $ loc "Excess flood"] |
|
51 |
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
|
52 |
em2 = [ByeClient $ loc "Excess flood"] |
10095 | 53 |
join1 = [Warning $ loc "Warning! Joins flood protection activated"] |
54 |
join2 = [ByeClient $ loc "Excess flood"] |
|
10094 | 55 |
|
10093 | 56 |
doCheck ei = do |
10094 | 57 |
curTime <- io getCurrentTime |
10095 | 58 |
let (numPerEntry, (sec1, num1), (sec2, num2), (ac1, ac2)) = boundaries e |
59 |
||
60 |
let nei = takeWhile ((>=) sec2 . diffUTCTime curTime . snd) ei |
|
61 |
let l2 = length nei |
|
62 |
let l1 = length $ takeWhile ((>=) sec1 . diffUTCTime curTime . snd) nei |
|
10094 | 63 |
|
10095 | 64 |
let actions = if l2 >= num2 + 1 || l1 >= num1 + 1 then |
65 |
ac2 |
|
66 |
else |
|
67 |
if l1 >= num1 || l2 >= num2 then |
|
68 |
ac1 |
|
69 |
else |
|
70 |
[] |
|
10094 | 71 |
|
11466
4b5c7a5c49fd
Defer kicking to the time when everything is in consistent state
unc0rr
parents:
11046
diff
changeset
|
72 |
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
|
73 |
, 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
|
74 |
] |
10094 | 75 |
|
10093 | 76 |
updateInfo = return [ |
10094 | 77 |
ModifyClient $ transformField e |
78 |
$ \(h:hs) -> first (flip (-) 1) h : hs |
|
10093 | 79 |
] |