--- 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)
--- 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 =
--- 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
--- 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)
-
-
-