Get rid of lastLogins, implement bans system
authorunc0rr
Sun, 13 Mar 2011 20:21:27 +0300
changeset 5007 c401891fe5e0
parent 5006 6913d677c891
child 5008 af9e4a66111b
Get rid of lastLogins, implement bans system
gameServer/Actions.hs
gameServer/CoreTypes.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
--- 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)