# HG changeset patch # User unc0rr # Date 1300036887 -10800 # Node ID c401891fe5e0b362699da30173b37832f3b74e38 # Parent 6913d677c8917eeada2d1842a7e1b50b106a4e5a Get rid of lastLogins, implement bans system diff -r 6913d677c891 -r c401891fe5e0 gameServer/Actions.hs --- a/gameServer/Actions.hs Sun Mar 13 15:20:07 2011 +0300 +++ b/gameServer/Actions.hs Sun Mar 13 20:21:27 2011 +0300 @@ -4,6 +4,7 @@ import Control.Concurrent import qualified Data.Set as Set import qualified Data.Sequence as Seq +import qualified Data.List as L import System.Log.Logger import Control.Monad import Data.Time @@ -55,6 +56,9 @@ | PingAll | StatsAction | RestartServer Bool + | AddNick2Bans B.ByteString B.ByteString UTCTime + | AddIP2Bans B.ByteString B.ByteString UTCTime + | CheckBanned type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action] @@ -374,7 +378,7 @@ currentTime <- io getCurrentTime let msg = "Ban for " `B.append` (B.pack . show $ seconds) `B.append` "seconds (" `B.append` reason ` B.append` ")" mapM_ processAction [ - ModifyServerInfo (\s -> s{lastLogins = (clHost, (addUTCTime seconds currentTime, msg)) : lastLogins s}) + AddIP2Bans clHost msg (addUTCTime seconds currentTime) , KickClient banId ] @@ -398,15 +402,39 @@ return ci modify (\s -> s{clientIndex = Just newClId}) - processAction $ AnswerClients [sendChan cl] ["CONNECTED", "Hedgewars server http://www.hedgewars.org/", serverVersion] + mapM_ processAction + [ + AnswerClients [sendChan cl] ["CONNECTED", "Hedgewars server http://www.hedgewars.org/", serverVersion] + , CheckBanned + , AddIP2Bans (host cl) "Reconnected too fast" (addUTCTime 10 $ connectTime cl) + ] + + +processAction (AddNick2Bans n reason expiring) = do + processAction $ ModifyServerInfo (\s -> s{bans = BanByNick n reason expiring : bans s}) + +processAction (AddIP2Bans ip reason expiring) = do + processAction $ ModifyServerInfo (\s -> s{bans = BanByIP ip reason expiring : bans s}) - let newLogins = takeWhile (\(_ , (time, _)) -> connectTime cl `diffUTCTime` time <= 0) $ lastLogins si - let info = host cl `Prelude.lookup` newLogins - if isJust info then - mapM_ processAction [ModifyServerInfo (\s -> s{lastLogins = newLogins}), ByeClient (snd . fromJust $ info)] - else - processAction $ ModifyServerInfo (\s -> s{lastLogins = (host cl, (addUTCTime 10 $ connectTime cl, "Reconnected too fast")) : newLogins}) - +processAction CheckBanned = do + clTime <- client's connectTime + clNick <- client's nick + clHost <- client's host + si <- gets serverInfo + let validBans = filter (checkNotExpired clTime) $ bans si + let ban = L.find (checkBan clHost clNick) $ validBans + when (isJust ban) $ + mapM_ processAction [ + ModifyServerInfo (\s -> s{bans = validBans}) + , ByeClient (getBanReason $ fromJust ban) + ] + where + checkNotExpired testTime (BanByIP _ _ time) = testTime `diffUTCTime` time <= 0 + checkNotExpired testTime (BanByNick _ _ time) = testTime `diffUTCTime` time <= 0 + checkBan ip _ (BanByIP bip _ _) = bip == ip + checkBan _ n (BanByNick bn _ _) = bn == n + getBanReason (BanByIP _ msg _) = msg + getBanReason (BanByNick _ msg _) = msg processAction PingAll = do rnc <- gets roomsClients diff -r 6913d677c891 -r c401891fe5e0 gameServer/CoreTypes.hs --- a/gameServer/CoreTypes.hs Sun Mar 13 15:20:07 2011 +0300 +++ b/gameServer/CoreTypes.hs Sun Mar 13 20:21:27 2011 +0300 @@ -125,7 +125,7 @@ dbName :: B.ByteString, dbLogin :: B.ByteString, dbPassword :: B.ByteString, - lastLogins :: [(B.ByteString, (UTCTime, B.ByteString))], + bans :: [BanInfo], restartPending :: Bool, coreChan :: Chan CoreMessage, dbQueries :: Chan DBQuery, @@ -192,6 +192,6 @@ instance Exception ShutdownThreadException data BanInfo = - BanByIP String UTCTime - | BanByNickname String UTCTime + BanByIP B.ByteString B.ByteString UTCTime + | BanByNick B.ByteString B.ByteString UTCTime deriving (Show, Read)