# HG changeset patch # User unc0rr # Date 1378233357 -14400 # Node ID 04e0acfa7c2ca557ccdbb00cb2a0550b64f6506a # Parent 4fd5df03deb8c2db02d5e9b4f3d1e9e8ed566ac4 /watch works in testing environment diff -r 4fd5df03deb8 -r 04e0acfa7c2c gameServer/Actions.hs --- a/gameServer/Actions.hs Tue Sep 03 00:05:38 2013 +0400 +++ b/gameServer/Actions.hs Tue Sep 03 22:35:57 2013 +0400 @@ -17,7 +17,7 @@ import Control.DeepSeq import Data.Unique import Control.Arrow -import Control.Exception +import Control.Exception as E import System.Process import Network.Socket import System.Random @@ -714,5 +714,24 @@ #endif processAction (ShowReplay name) = do - return () + c <- client's sendChan + cl <- client's id + + let fileName = B.concat ["checked/", if B.isPrefixOf "replays/" name then B.drop 8 name else name] + + checkInfo <- liftIO $ E.handle (\(e :: SomeException) -> + warningM "REPLAYS" (B.unpack $ B.concat ["Problems reading ", fileName, ": ", B.pack $ show e]) >> return Nothing) $ do + (t, p1, p2, msgs) <- liftM read $ readFile (B.unpack fileName) + return $ Just (t, Map.fromList p1, Map.fromList p2, reverse msgs) + let (teams, params1, params2, roundMsgs) = fromJust checkInfo + + when (isJust checkInfo) $ do + mapM_ processAction $ concat [ + [AnswerClients [c] ["JOINED", nick cl]] + , answerFullConfigParams cl params1 params2 + , answerAllTeams cl teams + , [AnswerClients [c] ["RUN_GAME"]] + , [AnswerClients [c] $ "EM" : roundMsgs] + , [AnswerClients [c] ["KICKED"]] + ] diff -r 4fd5df03deb8 -r 04e0acfa7c2c gameServer/HWProtoCore.hs --- a/gameServer/HWProtoCore.hs Tue Sep 03 00:05:38 2013 +0400 +++ b/gameServer/HWProtoCore.hs Tue Sep 03 22:35:57 2013 +0400 @@ -50,7 +50,7 @@ rnc <- liftM snd ask let chans = map (sendChan . client rnc) $ allClients rnc return [AnswerClients chans ["CHAT", "[global notice]", p] | isAdministrator cl] - h "WATCH" = return . QueryReplay + h "WATCH" f = return [QueryReplay f] h c p = return [Warning $ B.concat ["Unknown cmd: /", c, p]] handleCmd cmd = do diff -r 4fd5df03deb8 -r 04e0acfa7c2c gameServer/HWProtoLobbyState.hs --- a/gameServer/HWProtoLobbyState.hs Tue Sep 03 00:05:38 2013 +0400 +++ b/gameServer/HWProtoLobbyState.hs Tue Sep 03 22:35:57 2013 +0400 @@ -14,16 +14,6 @@ import EngineInteraction -answerAllTeams :: ClientInfo -> [TeamInfo] -> [Action] -answerAllTeams cl = concatMap toAnswer - where - clChan = sendChan cl - toAnswer team = - [AnswerClients [clChan] $ teamToNet team, - AnswerClients [clChan] ["TEAM_COLOR", teamname team, teamcolor team], - AnswerClients [clChan] ["HH_NUM", teamname team, showB $ hhnum team]] - - handleCmd_lobby :: CmdHandler diff -r 4fd5df03deb8 -r 04e0acfa7c2c gameServer/Utils.hs --- a/gameServer/Utils.hs Tue Sep 03 00:05:38 2013 +0400 +++ b/gameServer/Utils.hs Tue Sep 03 22:35:57 2013 +0400 @@ -157,5 +157,15 @@ toAnswer cl (paramName, paramStrs) = AnswerClients [sendChan cl] $ "CFG" : paramName : paramStrs +answerAllTeams :: ClientInfo -> [TeamInfo] -> [Action] +answerAllTeams cl = concatMap toAnswer + where + clChan = sendChan cl + toAnswer team = + [AnswerClients [clChan] $ teamToNet team, + AnswerClients [clChan] ["TEAM_COLOR", teamname team, teamcolor team], + AnswerClients [clChan] ["HH_NUM", teamname team, showB $ hhnum team]] + + loc :: B.ByteString -> B.ByteString loc = id