# HG changeset patch # User unc0rr # Date 1277658401 -14400 # Node ID 772a46ef82882215e0ec2f1926145dd4fd12c7e2 # Parent bc34101048943a41cebc492b621305ee97a5d637 Properly handle client exit diff -r bc3410104894 -r 772a46ef8288 gameServer/Actions.hs --- a/gameServer/Actions.hs Sat Jun 26 16:58:19 2010 +0400 +++ b/gameServer/Actions.hs Sun Jun 27 21:06:41 2010 +0400 @@ -4,6 +4,7 @@ import Control.Concurrent import Control.Concurrent.Chan import qualified Data.IntSet as IntSet +import qualified Data.Set as Set import qualified Data.Sequence as Seq import System.Log.Logger import Monad @@ -19,7 +20,7 @@ import ServerState data Action = - AnswerClients [ClientChan] [B.ByteString] + AnswerClients ![ClientChan] ![B.ByteString] | SendServerMessage | SendServerVars | MoveToRoom RoomIndex @@ -45,6 +46,7 @@ | ProcessAccountInfo AccountInfo | Dump | AddClient ClientInfo + | DeleteClient ClientIndex | PingAll | StatsAction @@ -101,19 +103,26 @@ return () chan <- client's sendChan + ready <- client's isReady liftIO $ do infoM "Clients" (show ci ++ " quits: " ++ (B.unpack msg)) - --mapM_ (processAction (ci, serverInfo, rnc)) $ answerOthersQuit ++ answerInformRoom writeChan chan ["BYE", msg] modifyRoom rnc (\r -> r{ --playersIDs = IntSet.delete ci (playersIDs r) - playersIn = (playersIn r) - 1 - --readyPlayers = if isReady client then readyPlayers r - 1 else readyPlayers r + playersIn = (playersIn r) - 1, + readyPlayers = if ready then readyPlayers r - 1 else readyPlayers r }) ri - + + removeClient rnc ci + + modify (\s -> s{removedClients = ci `Set.insert` removedClients s}) + +processAction (DeleteClient ci) = do + modify (\s -> s{removedClients = ci `Set.delete` removedClients s}) + {- where client = clients ! clID @@ -227,7 +236,8 @@ -} processAction (AddRoom roomName roomPassword) = do - (ServerState (Just clId) _ rnc) <- get + Just clId <- gets clientIndex + rnc <- gets roomsClients proto <- liftIO $ client'sM rnc clientProto clId let room = newRoom{ @@ -335,10 +345,10 @@ processAction JoinLobby = do chan <- client's sendChan clientNick <- client's nick - (lobbyNicks, clientsChans) <- liftM (unzip . Prelude.map (\c -> (nick c, sendChan c)) . Prelude.filter logonPassed) allClientsS + (lobbyNicks, clientsChans) <- liftM (unzip . Prelude.map (\c -> (nick c, sendChan c)) . Prelude.filter logonPassed) $! allClientsS mapM_ processAction $ (AnswerClients clientsChans ["LOBBY:JOINED", clientNick]) - : [AnswerClients [chan] ("LOBBY:JOINED" : lobbyNicks) | not $ Prelude.null lobbyNicks] + : [AnswerClients [chan] ("LOBBY:JOINED" : clientNick : lobbyNicks)] ++ [ModifyClient (\cl -> cl{logonPassed = True}), SendServerMessage] {- diff -r bc3410104894 -r 772a46ef8288 gameServer/ClientIO.hs --- a/gameServer/ClientIO.hs Sat Jun 26 16:58:19 2010 +0400 +++ b/gameServer/ClientIO.hs Sun Jun 27 21:06:41 2010 +0400 @@ -32,7 +32,7 @@ Left bufTail else Right (B.splitWith (== '\n') bsPacket, bufTail) - + listenLoop :: Socket -> Chan CoreMessage -> ClientIndex -> IO () listenLoop sock chan ci = recieveWithBufferLoop B.empty @@ -53,7 +53,7 @@ msg <- (listenLoop s chan ci >> return "Connection closed") `catch` (return . B.pack . show) clientOff msg where - clientOff msg = writeChan chan $ ClientMessage (ci, ["QUIT", msg]) + clientOff msg = mapM_ (writeChan chan) [ClientMessage (ci, ["QUIT", msg]), Remove ci] diff -r bc3410104894 -r 772a46ef8288 gameServer/CoreTypes.hs --- a/gameServer/CoreTypes.hs Sat Jun 26 16:58:19 2010 +0400 +++ b/gameServer/CoreTypes.hs Sun Jun 27 21:06:41 2010 +0400 @@ -173,7 +173,7 @@ | ClientMessage (ClientIndex, [B.ByteString]) | ClientAccountInfo (ClientIndex, AccountInfo) | TimerAction Int - | FreeClient ClientIndex + | Remove ClientIndex type MRnC = MRoomsAndClients RoomInfo ClientInfo type IRnC = IRoomsAndClients RoomInfo ClientInfo diff -r bc3410104894 -r 772a46ef8288 gameServer/HWProtoInRoomState.hs --- a/gameServer/HWProtoInRoomState.hs Sat Jun 26 16:58:19 2010 +0400 +++ b/gameServer/HWProtoInRoomState.hs Sun Jun 27 21:06:41 2010 +0400 @@ -48,7 +48,7 @@ clChan <- thisClientChans othersChans <- roomOthersChans return $ - if null . drop 5 $ teams r then + if not . null . drop 5 $ teams r then [Warning "too many teams"] else if canAddNumber r <= 0 then [Warning "too many hedgehogs"] @@ -73,6 +73,7 @@ Just (i, t) | B.null t -> fromIntegral i otherwise -> 0 hhsList [] = [] + hhsList [_] = error "Hedgehogs list with odd elements number" hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs newTeamHHNum r = min 4 (canAddNumber r) diff -r bc3410104894 -r 772a46ef8288 gameServer/HWProtoLobbyState.hs --- a/gameServer/HWProtoLobbyState.hs Sat Jun 26 16:58:19 2010 +0400 +++ b/gameServer/HWProtoLobbyState.hs Sun Jun 27 21:06:41 2010 +0400 @@ -33,13 +33,7 @@ let roomsInfoList = concatMap (roomInfo irnc) . filter (\r -> (roomProto r == clientProto cl) && not (isRestrictedJoins r)) return [AnswerClients [sendChan cl] ("ROOMS" : roomsInfoList rooms)] where - roomInfo irnc room - | roomProto room < 28 = [ - name room, - B.pack $ show (playersIn room) ++ "(" ++ show (length $ teams room) ++ ")", - B.pack $ show $ gameinprogress room - ] - | otherwise = [ + roomInfo irnc room = [ showB $ gameinprogress room, name room, showB $ playersIn room, diff -r bc3410104894 -r 772a46ef8288 gameServer/HWProtoNEState.hs --- a/gameServer/HWProtoNEState.hs Sat Jun 26 16:58:19 2010 +0400 +++ b/gameServer/HWProtoNEState.hs Sun Jun 27 21:06:41 2010 +0400 @@ -35,9 +35,9 @@ (ci, irnc) <- ask let cl = irnc `client` ci if clientProto cl > 0 then return [ProtocolError "Protocol already known"] - else + else if parsedProto == 0 then return [ProtocolError "Bad number"] - else + else return $ ModifyClient (\c -> c{clientProto = parsedProto}) : AnswerClients [sendChan cl] ["PROTO", B.pack $ show parsedProto] : diff -r bc3410104894 -r 772a46ef8288 gameServer/RoomsAndClients.hs --- a/gameServer/RoomsAndClients.hs Sat Jun 26 16:58:19 2010 +0400 +++ b/gameServer/RoomsAndClients.hs Sun Jun 27 21:06:41 2010 +0400 @@ -48,7 +48,7 @@ newtype RoomIndex = RoomIndex ElemIndex deriving (Eq) newtype ClientIndex = ClientIndex ElemIndex - deriving (Eq, Show, Read) + deriving (Eq, Show, Read, Ord) instance Show RoomIndex where show (RoomIndex i) = 'r' : show i diff -r bc3410104894 -r 772a46ef8288 gameServer/ServerCore.hs --- a/gameServer/ServerCore.hs Sat Jun 26 16:58:19 2010 +0400 +++ b/gameServer/ServerCore.hs Sun Jun 27 21:06:41 2010 +0400 @@ -8,6 +8,7 @@ import System.Log.Logger import Control.Monad.Reader import Control.Monad.State +import Data.Set as Set import qualified Data.ByteString.Char8 as B -------------------------------------- import CoreTypes @@ -35,29 +36,27 @@ r <- liftIO $ readChan $ coreChan si case r of - Accept ci -> do - processAction (AddClient ci) - return () + Accept ci -> processAction (AddClient ci) ClientMessage (ci, cmd) -> do liftIO $ debugM "Clients" $ (show ci) ++ ": " ++ (show cmd) - modify (\as -> as{clientIndex = Just ci}) - --if clID `IntMap.member` clients then - reactCmd cmd - return () + + removed <- gets removedClients + when (not $ ci `Set.member` removed) $ do + modify (\as -> as{clientIndex = Just ci}) + reactCmd cmd + + Remove ci -> processAction (DeleteClient ci) + --else --do --debugM "Clients" "Message from dead client" --return (serverInfo, rnc) - ClientAccountInfo (clID, info) -> do - --if clID `IntMap.member` clients then - processAction (ProcessAccountInfo info) - return () - --else - --do - --debugM "Clients" "Got info for dead client" - --return (serverInfo, rnc) + ClientAccountInfo (ci, info) -> do + removed <- gets removedClients + when (not $ ci `Set.member` removed) $ + processAction (ProcessAccountInfo info) TimerAction tick -> return () @@ -65,10 +64,6 @@ -- foldM processAction (0, serverInfo, rnc) $ -- PingAll : [StatsAction | even tick] - FreeClient ci -> do - rnc <- gets roomsClients - liftIO $ removeClient rnc ci - startServer :: ServerInfo -> Socket -> IO () startServer serverInfo serverSocket = do @@ -87,6 +82,6 @@ rnc <- newRoomsAndClients newRoom - forkIO $ evalStateT mainLoop (ServerState Nothing serverInfo rnc) + forkIO $ evalStateT mainLoop (ServerState Nothing serverInfo Set.empty rnc) forever $ threadDelay (60 * 60 * 10^6) >> putStrLn "***" diff -r bc3410104894 -r 772a46ef8288 gameServer/ServerState.hs --- a/gameServer/ServerState.hs Sat Jun 26 16:58:19 2010 +0400 +++ b/gameServer/ServerState.hs Sun Jun 27 21:06:41 2010 +0400 @@ -9,6 +9,7 @@ ) where import Control.Monad.State +import Data.Set as Set ---------------------- import RoomsAndClients import CoreTypes @@ -16,6 +17,7 @@ data ServerState = ServerState { clientIndex :: Maybe ClientIndex, serverInfo :: ServerInfo, + removedClients :: Set.Set ClientIndex, roomsClients :: MRnC } diff -r bc3410104894 -r 772a46ef8288 gameServer/Store.hs --- a/gameServer/Store.hs Sat Jun 26 16:58:19 2010 +0400 +++ b/gameServer/Store.hs Sun Jun 27 21:06:41 2010 +0400 @@ -24,7 +24,7 @@ newtype ElemIndex = ElemIndex Int - deriving (Eq, Show, Read) + deriving (Eq, Show, Read, Ord) newtype MStore e = MStore (IORef (IntSet.IntSet, IntSet.IntSet, IOA.IOArray Int e)) newtype IStore e = IStore (IntSet.IntSet, IA.Array Int e) @@ -105,7 +105,7 @@ m2i :: MStore e -> IO (IStore e) m2i (MStore ref) = do (a, _, c') <- readIORef ref - c <- IOA.unsafeFreeze c' + c <- IOA.freeze c' return $ IStore (a, c)