# HG changeset patch # User unc0rr # Date 1357939130 -14400 # Node ID 0551b5c3de9a1e50ed2b2d441855bba573966c35 # Parent 0c79946e96f8ef55c69554b81f1dc19c7213f87a - Start work on checker - Various small fixes diff -r 0c79946e96f8 -r 0551b5c3de9a gameServer/Actions.hs --- a/gameServer/Actions.hs Thu Jan 10 22:59:46 2013 +0400 +++ b/gameServer/Actions.hs Sat Jan 12 01:18:50 2013 +0400 @@ -420,9 +420,11 @@ n <- client's nick h <- client's host p <- client's clientProto + checker <- client's isChecker uid <- client's clUID - haveSameNick <- liftM (not . null . tail . filter (\c -> caseInsensitiveCompare (nick c) n)) allClientsS - if haveSameNick then + -- allow multiple checker logins + haveSameNick <- liftM (not . null . tail . filter (\c -> (not $ isChecker c) && caseInsensitiveCompare (nick c) n)) allClientsS + if haveSameNick && (not checker) then if p < 38 then processAction $ ByeClient "Nickname is already in use" else @@ -636,6 +638,7 @@ processAction SaveReplay = do ri <- clientRoomA rnc <- gets roomsClients + io $ do r <- room'sM rnc id ri saveReplay r diff -r 0c79946e96f8 -r 0551b5c3de9a gameServer/ClientIO.hs --- a/gameServer/ClientIO.hs Thu Jan 10 22:59:46 2013 +0400 +++ b/gameServer/ClientIO.hs Sat Jan 12 01:18:50 2013 +0400 @@ -30,25 +30,26 @@ return (B.splitWith (== '\n') packet : packets) listenLoop :: Socket -> Chan CoreMessage -> ClientIndex -> IO () -listenLoop sock chan ci = recieveWithBufferLoop B.empty +listenLoop sock chan ci = receiveWithBufferLoop B.empty where - recieveWithBufferLoop recvBuf = do + receiveWithBufferLoop recvBuf = do recvBS <- recv sock 4096 unless (B.null recvBS) $ do let (packets, newrecvBuf) = bs2Packets $ B.append recvBuf recvBS forM_ packets sendPacket - recieveWithBufferLoop newrecvBuf + receiveWithBufferLoop newrecvBuf sendPacket packet = writeChan chan $ ClientMessage (ci, packet) clientRecvLoop :: Socket -> Chan CoreMessage -> Chan [B.ByteString] -> ClientIndex -> (forall a. IO a -> IO a) -> IO () clientRecvLoop s chan clChan ci restore = (myThreadId >>= - \t -> (restore $ forkIO (clientSendLoop s t clChan ci) >> + (\t -> (restore $ forkIO (clientSendLoop s t clChan ci) >> listenLoop s chan ci >> return "Connection closed") `Exception.catch` (\(e :: ShutdownThreadException) -> return . B.pack . show $ e) `Exception.catch` (\(e :: Exception.IOException) -> return . B.pack . show $ e) `Exception.catch` (\(e :: Exception.SomeException) -> return . B.pack . show $ e) + ) >>= clientOff) `Exception.finally` remove where clientOff msg = writeChan chan $ ClientMessage (ci, ["QUIT", msg]) diff -r 0c79946e96f8 -r 0551b5c3de9a gameServer/CoreTypes.hs --- a/gameServer/CoreTypes.hs Thu Jan 10 22:59:46 2013 +0400 +++ b/gameServer/CoreTypes.hs Sat Jan 12 01:18:50 2013 +0400 @@ -35,6 +35,7 @@ isReady :: !Bool, isInGame :: Bool, isAdministrator :: Bool, + isChecker :: Bool, isKickedFromServer :: Bool, clientClan :: Maybe B.ByteString, teamsInGame :: Word diff -r 0c79946e96f8 -r 0551b5c3de9a gameServer/HWProtoNEState.hs --- a/gameServer/HWProtoNEState.hs Thu Jan 10 22:59:46 2013 +0400 +++ b/gameServer/HWProtoNEState.hs Sat Jan 12 01:18:50 2013 +0400 @@ -48,4 +48,17 @@ return [ByeClient "Authentication failed"] +handleCmd_NotEntered ["CHECKER", protoNum, newNick, password] = do + (ci, irnc) <- ask + let cl = irnc `client` ci + + if parsedProto == 0 then return [ProtocolError "Bad number"] + else + return $ [ + ModifyClient (\c -> c{clientProto = parsedProto, nick = newNick, webPassword = password, isChecker = True}) + , CheckRegistered] + where + parsedProto = readInt_ protoNum + + handleCmd_NotEntered _ = return [ProtocolError "Incorrect command (state: not entered)"] diff -r 0c79946e96f8 -r 0551b5c3de9a gameServer/NetRoutines.hs --- a/gameServer/NetRoutines.hs Thu Jan 10 22:59:46 2013 +0400 +++ b/gameServer/NetRoutines.hs Sat Jan 12 01:18:50 2013 +0400 @@ -42,6 +42,7 @@ False False False + False Nothing 0 ) diff -r 0c79946e96f8 -r 0551b5c3de9a gameServer/OfficialServer/GameReplayStore.hs --- a/gameServer/OfficialServer/GameReplayStore.hs Thu Jan 10 22:59:46 2013 +0400 +++ b/gameServer/OfficialServer/GameReplayStore.hs Sat Jan 12 01:18:50 2013 +0400 @@ -14,7 +14,7 @@ saveReplay :: RoomInfo -> IO () -saveReplay r = do +saveReplay r = when allPlayersHaveRegisteredAccounts $ do time <- getCurrentTime u <- liftM hashUnique newUnique let fileName = "replays/" ++ show time ++ "-" ++ show u @@ -23,4 +23,3 @@ E.catch (writeFile fileName (show replayInfo)) (\(e :: IOException) -> warningM "REPLAYS" $ "Couldn't write to " ++ fileName ++ ": " ++ show e) - \ No newline at end of file diff -r 0c79946e96f8 -r 0551b5c3de9a gameServer/ServerState.hs --- a/gameServer/ServerState.hs Thu Jan 10 22:59:46 2013 +0400 +++ b/gameServer/ServerState.hs Sat Jan 12 01:18:50 2013 +0400 @@ -49,6 +49,6 @@ sameProtoClientsS p = liftM f allClientsS where f = filter (\c -> clientProto c == p) - + io :: IO a -> StateT ServerState IO a io = liftIO