diff -r 31570b766315 -r ed5a6478e710 gameServer/FloodDetection.hs --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/gameServer/FloodDetection.hs Tue Nov 10 20:43:13 2015 +0100 @@ -0,0 +1,77 @@ +{- + * Hedgewars, a free turn based strategy game + * Copyright (c) 2004-2015 Andrey Korotaev + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; version 2 of the License + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + \-} + +{-# LANGUAGE OverloadedStrings, BangPatterns #-} +module FloodDetection where + +import Control.Monad.State.Strict +import Data.Time +import Control.Arrow +---------------- +import ServerState +import CoreTypes +import Utils + +registerEvent :: Event -> StateT ServerState IO [Action] +registerEvent e = do + eventInfo <- client's $ einfo e + if (null eventInfo) || 0 == (fst $ head eventInfo) then doCheck eventInfo else updateInfo + + where + einfo LobbyChatMessage = eiLobbyChat + einfo EngineMessage = eiEM + einfo RoomJoin = eiJoin + + transformField LobbyChatMessage f = \c -> c{eiLobbyChat = f $ eiLobbyChat c} + transformField EngineMessage f = \c -> c{eiEM = f $ eiEM c} + transformField RoomJoin f = \c -> c{eiJoin = f $ eiJoin c} + + boundaries :: Event -> (Int, (NominalDiffTime, Int), (NominalDiffTime, Int), ([Action], [Action])) + boundaries LobbyChatMessage = (3, (10, 2), (30, 3), (chat1, chat2)) + boundaries EngineMessage = (8, (10, 4), (25, 5), (em1, em2)) + boundaries RoomJoin = (2, (10, 2), (35, 3), (join1, join2)) + + chat1 = [Warning $ loc "Warning! Chat flood protection activated"] + chat2 = [ByeClient $ loc "Excess flood"] + em1 = [Warning $ loc "Game messages flood detected - 1"] + em2 = [Warning $ loc "Game messages flood detected - 2"] + join1 = [Warning $ loc "Warning! Joins flood protection activated"] + join2 = [ByeClient $ loc "Excess flood"] + + doCheck ei = do + curTime <- io getCurrentTime + let (numPerEntry, (sec1, num1), (sec2, num2), (ac1, ac2)) = boundaries e + + let nei = takeWhile ((>=) sec2 . diffUTCTime curTime . snd) ei + let l2 = length nei + let l1 = length $ takeWhile ((>=) sec1 . diffUTCTime curTime . snd) nei + + let actions = if l2 >= num2 + 1 || l1 >= num1 + 1 then + ac2 + else + if l1 >= num1 || l2 >= num2 then + ac1 + else + [] + + return $ (ModifyClient . transformField e . const $ (numPerEntry, curTime) : nei) : actions + + updateInfo = return [ + ModifyClient $ transformField e + $ \(h:hs) -> first (flip (-) 1) h : hs + ]