# HG changeset patch
# User unc0rr
# Date 1238179818 0
# Node ID cb46fbdcaa41b10c07646019dbfaacf4e8da86b8
# Parent  ec923e56c4447eff08b415dc1fb9a9ec9f072f77
Add simple DoS protection mechanism (although better than previous server had)

diff -r ec923e56c444 -r cb46fbdcaa41 gameServer/Actions.hs
--- a/gameServer/Actions.hs	Fri Mar 27 15:58:54 2009 +0000
+++ b/gameServer/Actions.hs	Fri Mar 27 18:50:18 2009 +0000
@@ -7,6 +7,8 @@
 import qualified Data.Sequence as Seq
 import System.Log.Logger
 import Monad
+import Data.Time
+import Maybe
 -----------------------------
 import CoreTypes
 import Utils
@@ -39,6 +41,7 @@
 	| CheckRegistered
 	| ProcessAccountInfo AccountInfo
 	| Dump
+	| AddClient ClientInfo
 
 type CmdHandler = Int -> Clients -> Rooms -> [String] -> [Action]
 
@@ -108,7 +111,7 @@
 
 processAction (clID, serverInfo, clients, rooms) (ByeClient msg) = do
 	mapM_ (processAction (clID, serverInfo, clients, rooms)) $ answerOthersQuit ++ answerInformRoom
-	writeChan (sendChan $ clients ! clID) ["BYE"]
+	writeChan (sendChan $ clients ! clID) ["BYE", msg]
 	return (
 			0,
 			serverInfo,
@@ -305,6 +308,7 @@
 processAction (clID, serverInfo, clients, rooms) (KickClient kickID) = do
 	liftM2 replaceID (return clID) (processAction (kickID, serverInfo, clients, rooms) $ ByeClient "Kicked")
 
+
 processAction (clID, serverInfo, clients, rooms) (BanClient banNick) = do
 	return (clID, serverInfo, clients, rooms)
 
@@ -322,3 +326,16 @@
 		room = rooms ! (roomID client)
 		teamsToRemove = Prelude.filter (\t -> teamowner t == nick client) $ teams room
 		removeTeamsActions = Prelude.map (RemoveTeam . teamname) teamsToRemove
+
+
+processAction (clID, serverInfo, clients, rooms) (AddClient client) = do
+	let updatedClients = insert (clientUID client) client clients
+	infoM "Clients" ((show $ clientUID client) ++ ": new client. Time: " ++ (show $ connectTime client))
+	writeChan (sendChan $ client) ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"]
+
+	let newLogins = takeWhile (\(_ , time) -> (connectTime client) `diffUTCTime` time <= 20) $ lastLogins serverInfo
+
+	if isJust $ host client `Prelude.lookup` newLogins then
+		processAction (clID, serverInfo{lastLogins = newLogins}, updatedClients, rooms) $ ByeClient "Reconnected too fast"
+		else
+		return (clID, serverInfo{lastLogins = (host client, connectTime client) : newLogins}, updatedClients, rooms)
diff -r ec923e56c444 -r cb46fbdcaa41 gameServer/CoreTypes.hs
--- a/gameServer/CoreTypes.hs	Fri Mar 27 15:58:54 2009 +0000
+++ b/gameServer/CoreTypes.hs	Fri Mar 27 18:50:18 2009 +0000
@@ -8,6 +8,7 @@
 import qualified Data.IntMap as IntMap
 import qualified Data.IntSet as IntSet
 import Data.Sequence(Seq, empty)
+import Data.Time
 import Network
 
 
@@ -18,6 +19,7 @@
 		sendChan :: Chan [String],
 		clientHandle :: Handle,
 		host :: String,
+		connectTime :: UTCTime,
 		nick :: String,
 		webPassword :: String,
 		logonPassed :: Bool,
@@ -119,6 +121,7 @@
 		dbHost :: String,
 		dbLogin :: String,
 		dbPassword :: String,
+		lastLogins :: [(String, UTCTime)],
 		stats :: TMVar StatisticsInfo,
 		coreChan :: Chan CoreMessage,
 		dbQueries :: Chan DBQuery
@@ -137,6 +140,7 @@
 		""
 		""
 		""
+		[]
 	)
 
 data AccountInfo =
diff -r ec923e56c444 -r cb46fbdcaa41 gameServer/NetRoutines.hs
--- a/gameServer/NetRoutines.hs	Fri Mar 27 15:58:54 2009 +0000
+++ b/gameServer/NetRoutines.hs	Fri Mar 27 18:50:18 2009 +0000
@@ -26,7 +26,6 @@
 		clientHost <- sockAddr2String sockAddr
 
 		currentTime <- getCurrentTime
-		--putStrLn $ (show currentTime) ++ " new client id: " ++ (show nextID)
 		
 		sendChan <- newChan
 
@@ -36,7 +35,7 @@
 					sendChan
 					cHandle
 					clientHost
-					--currentTime
+					currentTime
 					""
 					""
 					False
diff -r ec923e56c444 -r cb46fbdcaa41 gameServer/ServerCore.hs
--- a/gameServer/ServerCore.hs	Fri Mar 27 15:58:54 2009 +0000
+++ b/gameServer/ServerCore.hs	Fri Mar 27 18:50:18 2009 +0000
@@ -29,11 +29,8 @@
 	(newServerInfo, mClients, mRooms) <-
 		case r of
 			Accept ci -> do
-				let updatedClients = IntMap.insert (clientUID ci) ci clients
-				infoM "Clients" ("New client: id " ++ (show $ clientUID ci))
 				liftM firstAway $ processAction
-					(clientUID ci, serverInfo, updatedClients, rooms)
-					(AnswerThisClient ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"])
+					(clientUID ci, serverInfo, clients, rooms) (AddClient ci)
 
 			ClientMessage (clID, cmd) -> do
 				debugM "Clients" $ (show clID) ++ ": " ++ (show cmd)
@@ -79,6 +76,3 @@
 	startDBConnection $ serverInfo
 
 	mainLoop serverInfo IntMap.empty (IntMap.singleton 0 newRoom)
-
-
-