--- a/QTfrontend/hwform.cpp Mon Feb 18 14:06:16 2013 -0500
+++ b/QTfrontend/hwform.cpp Thu Feb 21 11:13:00 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 Mon Feb 18 14:06:16 2013 -0500
+++ b/gameServer/Actions.hs Thu Feb 21 11:13:00 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 Mon Feb 18 14:06:16 2013 -0500
+++ b/gameServer/CoreTypes.hs Thu Feb 21 11:13:00 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 Mon Feb 18 14:06:16 2013 -0500
+++ b/gameServer/EngineInteraction.hs Thu Feb 21 11:13:00 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 Mon Feb 18 14:06:16 2013 -0500
+++ b/gameServer/HWProtoCore.hs Thu Feb 21 11:13:00 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 Mon Feb 18 14:06:16 2013 -0500
+++ b/gameServer/HWProtoInRoomState.hs Thu Feb 21 11:13:00 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 Mon Feb 18 14:06:16 2013 -0500
+++ b/gameServer/HWProtoLobbyState.hs Thu Feb 21 11:13:00 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 Mon Feb 18 14:06:16 2013 -0500
+++ b/gameServer/NetRoutines.hs Thu Feb 21 11:13:00 2013 +0400
@@ -47,6 +47,7 @@
Nothing
Nothing
0
+ []
)
writeChan chan $ Accept newClient
--- a/gameServer/OfficialServer/checker.hs Mon Feb 18 14:06:16 2013 -0500
+++ b/gameServer/OfficialServer/checker.hs Thu Feb 21 11:13:00 2013 +0400
@@ -29,12 +29,25 @@
| CheckSuccess [B.ByteString]
deriving Show
+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"
@@ -43,6 +56,7 @@
where
start = flip L.elem ["WINNERS", "DRAW"]
+
checkReplay :: Chan Message -> [B.ByteString] -> IO ()
checkReplay coreChan msgs = do
tempDir <- getTemporaryDirectory
@@ -51,7 +65,7 @@
hFlush h
hClose h
- (_, Just hErr, _, _) <- createProcess (proc "/usr/home/unC0Rr/Sources/Hedgewars/Releases/0.9.18/bin/hwengine"
+ (_, Just hOut, _, _) <- createProcess (proc "/usr/home/unC0Rr/Sources/Hedgewars/Releases/0.9.18/bin/hwengine"
["/usr/home/unC0Rr/.hedgewars"
, "/usr/home/unC0Rr/Sources/Hedgewars/Releases/0.9.18/share/hedgewars/Data"
, fileName
@@ -61,8 +75,8 @@
, "0"
])
{std_out = CreatePipe}
- hSetBuffering hErr LineBuffering
- void $ forkIO $ engineListener coreChan hErr
+ hSetBuffering hOut LineBuffering
+ void $ forkIO $ engineListener coreChan hOut
takePacks :: State B.ByteString [[B.ByteString]]
@@ -125,7 +139,9 @@
answer ["CHECKER", protocolNumber, l, p]
answer ["READY"]
onPacket _ ["PING"] = answer ["PONG"]
- onPacket chan ("REPLAY":msgs) = checkReplay chan msgs
+ onPacket chan ("REPLAY":msgs) = do
+ checkReplay chan msgs
+ warningM "Check" "Started check"
onPacket _ ("BYE" : xs) = error $ show xs
onPacket _ _ = return ()
@@ -165,5 +181,3 @@
sock <- socket AF_INET Stream proto
connect sock (SockAddrInet 46631 host)
return sock
-
- serverAddress = "netserver.hedgewars.org"
--- a/hedgewars/CMakeLists.txt Mon Feb 18 14:06:16 2013 -0500
+++ b/hedgewars/CMakeLists.txt Thu Feb 21 11:13:00 2013 +0400
@@ -146,6 +146,10 @@
list(APPEND pascal_flags "-k${SDLMAIN_LIB}")
endif()
+
+ #when you have multiple ld installation make sure you get the one bundled with the compiler
+ get_filename_component(compiler_dir ${CMAKE_C_COMPILER} PATH)
+ list(APPEND pascal_flags "-FD${compiler_dir}")
endif(APPLE)
if(NOT NOPNG)