--- a/QTfrontend/hwform.cpp Wed Feb 20 01:55:23 2013 +0100
+++ b/QTfrontend/hwform.cpp Thu Feb 21 11:12:42 2013 +0400
@@ -1202,7 +1202,7 @@
connect(hwnet, SIGNAL(LeftRoom(const QString&)), this, SLOT(NetLeftRoom(const QString&)), Qt::QueuedConnection);
connect(hwnet, SIGNAL(AddNetTeam(const HWTeam&)), this, SLOT(AddNetTeam(const HWTeam&)), Qt::QueuedConnection);
connect(hwnet, SIGNAL(RemoveNetTeam(const HWTeam&)), this, SLOT(RemoveNetTeam(const HWTeam&)), Qt::QueuedConnection);
- connect(hwnet, SIGNAL(TeamAccepted(const QString&)), this, SLOT(NetTeamAccepted(const QString&)), Qt::QueuedConnection);
+ connect(hwnet, SIGNAL(TeamAccepted(const QString&)), this, SLOT(NetTeamAccepted(const QString&)));
connect(hwnet, SIGNAL(NickRegistered(const QString&)), this, SLOT(NetNickRegistered(const QString&)), Qt::QueuedConnection);
connect(hwnet, SIGNAL(NickNotRegistered(const QString&)), this, SLOT(NetNickNotRegistered(const QString&)), Qt::QueuedConnection);
connect(hwnet, SIGNAL(NickTaken(const QString&)), this, SLOT(NetNickTaken(const QString&)), Qt::QueuedConnection);
--- a/gameServer/Actions.hs Wed Feb 20 01:55:23 2013 +0100
+++ b/gameServer/Actions.hs Thu Feb 21 11:12:42 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
@@ -461,8 +402,12 @@
when (not b) $ (if c then checkerLogin else playerLogin) passwd isAdmin
Guest -> do
b <- isBanned
+ c <- client's isChecker
when (not b) $
- processAction JoinLobby
+ if c then
+ checkerLogin "" False
+ else
+ processAction JoinLobby
Admin -> do
mapM_ processAction [ModifyClient (\cl -> cl{isAdministrator = True}), JoinLobby]
chan <- client's sendChan
@@ -594,6 +539,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 +559,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 Wed Feb 20 01:55:23 2013 +0100
+++ b/gameServer/CoreTypes.hs Thu Feb 21 11:12:42 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/EngineInteraction.hs Wed Feb 20 01:55:23 2013 +0100
+++ b/gameServer/EngineInteraction.hs Thu Feb 21 11:12:42 2013 +0400
@@ -93,7 +93,7 @@
eml ["eaddteam <hash> ", showB $ (1 + (readInt_ $ teamcolor t) :: Int) * 1234, " ", teamname t]
: em "erdriven"
: eml ["efort ", teamfort t]
- : take (hhnum t) (
+ : take (2 * hhnum t) (
concatMap (\(HedgehogInfo hname hhat) -> [
eml ["eaddhh ", showB $ difficulty t, " ", initHealth, " ", hname]
, eml ["ehat ", hhat]
--- a/gameServer/HWProtoCore.hs Wed Feb 20 01:55:23 2013 +0100
+++ b/gameServer/HWProtoCore.hs Thu Feb 21 11:12:42 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/HWProtoInRoomState.hs Wed Feb 20 01:55:23 2013 +0100
+++ b/gameServer/HWProtoInRoomState.hs Thu Feb 21 11:12:42 2013 +0400
@@ -77,9 +77,11 @@
SendUpdateOnThisRoom,
ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = Just teamColor}),
AnswerClients clChan ["TEAM_ACCEPTED", tName],
- AnswerClients clChan ["HH_NUM", tName, showB $ hhnum newTeam],
AnswerClients othChans $ teamToNet $ newTeam,
- AnswerClients roomChans ["TEAM_COLOR", tName, teamColor]
+ AnswerClients roomChans ["TEAM_COLOR", tName, teamColor],
+ ModifyClient $ \c -> c{actionsPending = actionsPending cl
+ ++ [AnswerClients clChan ["HH_NUM", tName, showB $ hhnum newTeam]]},
+ AnswerClients [sendChan cl] ["PING"]
]
where
canAddNumber rt = (48::Int) - (sum $ map hhnum rt)
--- a/gameServer/HWProtoLobbyState.hs Wed Feb 20 01:55:23 2013 +0100
+++ b/gameServer/HWProtoLobbyState.hs Thu Feb 21 11:12:42 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 Wed Feb 20 01:55:23 2013 +0100
+++ b/gameServer/NetRoutines.hs Thu Feb 21 11:12:42 2013 +0400
@@ -47,6 +47,7 @@
Nothing
Nothing
0
+ []
)
writeChan chan $ Accept newClient
--- a/gameServer/OfficialServer/checker.hs Wed Feb 20 01:55:23 2013 +0100
+++ b/gameServer/OfficialServer/checker.hs Thu Feb 21 11:12:42 2013 +0400
@@ -32,10 +32,22 @@
serverAddress = "netserver.hedgewars.org"
protocolNumber = "43"
+getLines :: Handle -> IO [String]
+getLines h = g
+ where
+ g = do
+ l <- liftM Just (hGetLine h) `Exception.catch` (\(_ :: Exception.IOException) -> return Nothing)
+ if isNothing l then
+ return []
+ else
+ do
+ lst <- g
+ return $ fromJust l : lst
+
engineListener :: Chan Message -> Handle -> IO ()
engineListener coreChan h = do
- output <- liftM lines $ hGetContents h
+ output <- getLines h
debugM "Engine" $ show output
if isNothing $ L.find start output then
writeChan coreChan $ CheckFailed "No stats msg"