# HG changeset patch
# User unc0rr
# Date 1311399051 -14400
# Node ID 109e9b5761c2ce3475192974888ff8a9ce150516
# Parent  48b7823ec7e485bba8181b448122535021f05844
Implement command for banning by ip and a command for bans list

diff -r 48b7823ec7e4 -r 109e9b5761c2 gameServer/Actions.hs
--- a/gameServer/Actions.hs	Wed Jul 20 00:09:13 2011 +0200
+++ b/gameServer/Actions.hs	Sat Jul 23 09:30:51 2011 +0400
@@ -45,6 +45,8 @@
     | KickClient ClientIndex
     | KickRoomClient ClientIndex
     | BanClient NominalDiffTime B.ByteString ClientIndex
+    | BanIP B.ByteString NominalDiffTime B.ByteString
+    | BanList
     | ChangeMaster
     | RemoveClientTeams ClientIndex
     | ModifyClient (ClientInfo -> ClientInfo)
@@ -393,12 +395,25 @@
     modify (\s -> s{clientIndex = Just banId})
     clHost <- client's host
     currentTime <- io getCurrentTime
-    let msg = B.concat ["Ban for ", B.pack . show $ seconds, "seconds (", reason, ")"]
+    let msg = B.concat ["Ban for ", B.pack . show $ seconds, " (", reason, ")"]
     mapM_ processAction [
         AddIP2Bans clHost msg (addUTCTime seconds currentTime)
         , KickClient banId
         ]
 
+processAction (BanIP ip seconds reason) = do
+    currentTime <- io getCurrentTime
+    let msg = B.concat ["Ban for ", B.pack . show $ seconds, " (", reason, ")"]
+    processAction $
+        AddIP2Bans ip msg (addUTCTime seconds currentTime)
+
+processAction BanList = do
+    ch <- client's sendChan
+    bans <- gets (bans . serverInfo)
+    processAction $
+        AnswerClients [ch] ["BANLIST", B.pack $ show bans]
+    
+
 
 processAction (KickRoomClient kickId) = do
     modify (\s -> s{clientIndex = Just kickId})
@@ -442,15 +457,13 @@
     si <- gets serverInfo
     let validBans = filter (checkNotExpired clTime) $ bans si
     let ban = L.find (checkBan clHost clNick) $ validBans
-    when (isJust ban) $
-        mapM_ processAction [
+    mapM_ processAction $
         ModifyServerInfo (\s -> s{bans = validBans})
-        , ByeClient (getBanReason $ fromJust ban)
-        ]
+        : [ByeClient (getBanReason $ fromJust ban) | isJust 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 ip _ (BanByIP bip _ _) = bip `B.isPrefixOf` ip
         checkBan _ n (BanByNick bn _ _) = bn == n
         getBanReason (BanByIP _ msg _) = msg
         getBanReason (BanByNick _ msg _) = msg
diff -r 48b7823ec7e4 -r 109e9b5761c2 gameServer/HWProtoLobbyState.hs
--- a/gameServer/HWProtoLobbyState.hs	Wed Jul 20 00:09:13 2011 +0200
+++ b/gameServer/HWProtoLobbyState.hs	Sat Jul 23 09:30:51 2011 +0400
@@ -154,6 +154,16 @@
     cl <- thisClient
     banId <- clientByNick banNick
     return [BanClient 60 reason (fromJust banId) | isAdministrator cl && isJust banId && fromJust banId /= ci]
+    
+handleCmd_lobby ["BANIP", ip, reason, duration] = do
+    (ci, _) <- ask
+    cl <- thisClient
+    return [BanIP ip (readInt_ duration) reason | isAdministrator cl]
+    
+handleCmd_lobby ["BANLIST"] = do
+    (ci, _) <- ask
+    cl <- thisClient
+    return [BanList | isAdministrator cl]
 
 
 handleCmd_lobby ["SET_SERVER_VAR", "MOTD_NEW", newMessage] = do