--- a/gameServer/Actions.hs Tue Feb 19 22:03:33 2013 +0400
+++ b/gameServer/Actions.hs Wed Feb 20 22:54:16 2013 +0400
@@ -32,68 +32,9 @@
import ConfigFile
import EngineInteraction
-data Action =
- AnswerClients ![ClientChan] ![B.ByteString]
- | SendServerMessage
- | SendServerVars
- | MoveToRoom RoomIndex
- | MoveToLobby B.ByteString
- | RemoveTeam B.ByteString
- | SendTeamRemovalMessage B.ByteString
- | RemoveRoom
- | FinishGame
- | UnreadyRoomClients
- | JoinLobby
- | ProtocolError B.ByteString
- | Warning B.ByteString
- | NoticeMessage Notice
- | ByeClient B.ByteString
- | KickClient ClientIndex
- | KickRoomClient ClientIndex
- | BanClient NominalDiffTime B.ByteString ClientIndex
- | BanIP B.ByteString NominalDiffTime B.ByteString
- | BanNick B.ByteString NominalDiffTime B.ByteString
- | BanList
- | Unban B.ByteString
- | ChangeMaster (Maybe ClientIndex)
- | RemoveClientTeams
- | ModifyClient (ClientInfo -> ClientInfo)
- | ModifyClient2 ClientIndex (ClientInfo -> ClientInfo)
- | ModifyRoomClients (ClientInfo -> ClientInfo)
- | ModifyRoom (RoomInfo -> RoomInfo)
- | ModifyServerInfo (ServerInfo -> ServerInfo)
- | AddRoom B.ByteString B.ByteString
- | SendUpdateOnThisRoom
- | CheckRegistered
- | ClearAccountsCache
- | ProcessAccountInfo AccountInfo
- | AddClient ClientInfo
- | DeleteClient ClientIndex
- | PingAll
- | StatsAction
- | RestartServer
- | AddNick2Bans B.ByteString B.ByteString UTCTime
- | AddIP2Bans B.ByteString B.ByteString UTCTime
- | CheckBanned Bool
- | SaveReplay
- | Stats
- | CheckRecord
- | CheckFailed B.ByteString
- | CheckSuccess [B.ByteString]
-
type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
-instance NFData Action where
- rnf (AnswerClients chans msg) = chans `deepseq` msg `deepseq` ()
- rnf a = a `seq` ()
-
-#if __GLASGOW_HASKELL__ < 706
-instance NFData B.ByteString
-#endif
-
-instance NFData (Chan a)
-
othersChans :: StateT ServerState IO [ClientChan]
othersChans = do
@@ -594,6 +535,7 @@
when (not $ ci `Set.member` rc)
$ processAction $ ModifyServerInfo (\s -> s{bans = BanByIP ip reason expiring : bans s})
+
processAction (CheckBanned byIP) = do
clTime <- client's connectTime
clNick <- client's nick
@@ -613,6 +555,7 @@
getBanReason (BanByIP _ msg _) = msg
getBanReason (BanByNick _ msg _) = msg
+
processAction PingAll = do
rnc <- gets roomsClients
io (allClientsM rnc) >>= mapM_ (kickTimeouted rnc)
--- a/gameServer/CoreTypes.hs Tue Feb 19 22:03:33 2013 +0400
+++ b/gameServer/CoreTypes.hs Wed Feb 20 22:54:16 2013 +0400
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-}
+{-# LANGUAGE CPP, OverloadedStrings, DeriveDataTypeable #-}
module CoreTypes where
import Control.Concurrent
@@ -12,9 +12,70 @@
import Control.Exception
import Data.Typeable
import Data.TConfig
+import Control.DeepSeq
-----------------------
import RoomsAndClients
+
+#if __GLASGOW_HASKELL__ < 706
+instance NFData B.ByteString
+#endif
+
+instance NFData (Chan a)
+
+instance NFData Action where
+ rnf (AnswerClients chans msg) = chans `deepseq` msg `deepseq` ()
+ rnf a = a `seq` ()
+
+data Action =
+ AnswerClients ![ClientChan] ![B.ByteString]
+ | SendServerMessage
+ | SendServerVars
+ | MoveToRoom RoomIndex
+ | MoveToLobby B.ByteString
+ | RemoveTeam B.ByteString
+ | SendTeamRemovalMessage B.ByteString
+ | RemoveRoom
+ | FinishGame
+ | UnreadyRoomClients
+ | JoinLobby
+ | ProtocolError B.ByteString
+ | Warning B.ByteString
+ | NoticeMessage Notice
+ | ByeClient B.ByteString
+ | KickClient ClientIndex
+ | KickRoomClient ClientIndex
+ | BanClient NominalDiffTime B.ByteString ClientIndex
+ | BanIP B.ByteString NominalDiffTime B.ByteString
+ | BanNick B.ByteString NominalDiffTime B.ByteString
+ | BanList
+ | Unban B.ByteString
+ | ChangeMaster (Maybe ClientIndex)
+ | RemoveClientTeams
+ | ModifyClient (ClientInfo -> ClientInfo)
+ | ModifyClient2 ClientIndex (ClientInfo -> ClientInfo)
+ | ModifyRoomClients (ClientInfo -> ClientInfo)
+ | ModifyRoom (RoomInfo -> RoomInfo)
+ | ModifyServerInfo (ServerInfo -> ServerInfo)
+ | AddRoom B.ByteString B.ByteString
+ | SendUpdateOnThisRoom
+ | CheckRegistered
+ | ClearAccountsCache
+ | ProcessAccountInfo AccountInfo
+ | AddClient ClientInfo
+ | DeleteClient ClientIndex
+ | PingAll
+ | StatsAction
+ | RestartServer
+ | AddNick2Bans B.ByteString B.ByteString UTCTime
+ | AddIP2Bans B.ByteString B.ByteString UTCTime
+ | CheckBanned Bool
+ | SaveReplay
+ | Stats
+ | CheckRecord
+ | CheckFailed B.ByteString
+ | CheckSuccess [B.ByteString]
+
type ClientChan = Chan [B.ByteString]
data CheckInfo =
@@ -47,7 +108,8 @@
isKickedFromServer :: Bool,
clientClan :: !(Maybe B.ByteString),
checkInfo :: Maybe CheckInfo,
- teamsInGame :: Word
+ teamsInGame :: Word,
+ actionsPending :: [Action]
}
instance Eq ClientInfo where
--- a/gameServer/HWProtoCore.hs Tue Feb 19 22:03:33 2013 +0400
+++ b/gameServer/HWProtoCore.hs Wed Feb 20 22:54:16 2013 +0400
@@ -30,7 +30,7 @@
handleCmd ["PONG"] = do
cl <- thisClient
if pingsQueue cl == 0 then
- return [ProtocolError "Protocol violation"]
+ return $ actionsPending cl ++ [ModifyClient (\c -> c{actionsPending = []})]
else
return [ModifyClient (\c -> c{pingsQueue = pingsQueue c - 1})]
--- a/gameServer/HWProtoLobbyState.hs Tue Feb 19 22:03:33 2013 +0400
+++ b/gameServer/HWProtoLobbyState.hs Wed Feb 20 22:54:16 2013 +0400
@@ -92,9 +92,12 @@
, AnswerClients [sendChan cl] $ ["CLIENT_FLAGS", "+h", ownerNick]
]
++ (if clientProto cl < 38 then map (readynessMessage cl) jRoomClients else [sendStateFlags cl jRoomClients])
- ++ answerFullConfig cl (mapParams jRoom) (params jRoom)
- ++ answerTeams cl jRoom
- ++ watchRound cl jRoom chans
+ ++ [AnswerClients [sendChan cl] ["PING"]
+ , ModifyClient $ \c -> c{actionsPending = actionsPending cl
+ ++ answerFullConfig cl (mapParams jRoom) (params jRoom)
+ ++ answerTeams cl jRoom
+ ++ watchRound cl jRoom chans}
+ ]
where
readynessMessage cl c = AnswerClients [sendChan cl] [if isReady c then "READY" else "NOT_READY", nick c]
--- a/gameServer/NetRoutines.hs Tue Feb 19 22:03:33 2013 +0400
+++ b/gameServer/NetRoutines.hs Wed Feb 20 22:54:16 2013 +0400
@@ -47,6 +47,7 @@
Nothing
Nothing
0
+ []
)
writeChan chan $ Accept newClient