# HG changeset patch # User unc0rr # Date 1226095423 0 # Node ID 89e24edb6020329a2c465209a42c590bb9832610 # Parent 8af42b3f93d26a5439fb9ec80c1f70d47fa32c24 Make code flow more clear diff -r 8af42b3f93d2 -r 89e24edb6020 netserver/HWProto.hs --- a/netserver/HWProto.hs Fri Nov 07 17:02:22 2008 +0000 +++ b/netserver/HWProto.hs Fri Nov 07 22:03:43 2008 +0000 @@ -25,6 +25,7 @@ answerBadCmd = [(clientOnly, ["ERROR", "Bad command, state or incorrect parameter"])] answerNotMaster = [(clientOnly, ["ERROR", "You cannot configure room parameters"])] answerBadParam = [(clientOnly, ["ERROR", "Bad parameter"])] +answerErrorMsg msg = [(clientOnly, ["ERROR", msg])] answerQuit msg = [(clientOnly, ["BYE", msg])] answerAbandoned = [(othersInRoom, ["BYE", "Room abandoned"])] answerQuitInform nick = [(othersInRoom, ["LEFT", nick])] @@ -93,6 +94,9 @@ handleCmd _ _ _ ["PONG"] = (noChangeClients, noChangeRooms, []) +handleCmd _ _ _ ["ERROR", msg] = + (noChangeClients, noChangeRooms, answerErrorMsg msg) + -- check state and call state-dependent commmand handlers handleCmd client clients rooms cmd = if null (nick client) || protocol client == 0 then diff -r 8af42b3f93d2 -r 89e24edb6020 netserver/hedgewars-server.hs --- a/netserver/hedgewars-server.hs Fri Nov 07 17:02:22 2008 +0000 +++ b/netserver/hedgewars-server.hs Fri Nov 07 22:03:43 2008 +0000 @@ -29,13 +29,18 @@ atomically $ writeTChan messagesChan ["PING"] acceptLoop :: Socket -> TChan ClientInfo -> IO () -acceptLoop servSock acceptChan = Control.Exception.handle (const $ putStrLn "exception on connect" >> acceptLoop servSock acceptChan) $ do +acceptLoop servSock acceptChan = + Control.Exception.handle (const $ putStrLn "exception on connect" >> acceptLoop servSock acceptChan) $ + do (cHandle, host, _) <- accept servSock + currentTime <- getCurrentTime putStrLn $ (show currentTime) ++ " new client: " ++ host + cChan <- atomically newTChan forkIO $ clientLoop cHandle cChan - atomically $ writeTChan acceptChan (ClientInfo cChan cHandle host currentTime"" 0 "" False False False) + + atomically $ writeTChan acceptChan (ClientInfo cChan cHandle host currentTime "" 0 "" False False False) atomically $ writeTChan cChan ["ASKME"] acceptLoop servSock acceptChan @@ -96,12 +101,9 @@ let mclient = fromMaybe client $ find (== client) mclients clientsIn <- sendAnswers answers mclient mclients mrooms - let quitClient = find forceQuit $ clientsIn + mapM_ (\cl -> atomically $ writeTChan (chan cl) ["QUIT", "Kicked"]) $ filter forceQuit $ clientsIn - if isJust quitClient then - reactCmd ["QUIT", "Kicked"] (fromJust quitClient) clientsIn mrooms - else - return (clientsIn, mrooms) + return (clientsIn, mrooms) mainLoop :: TChan ClientInfo -> TChan [String] -> [ClientInfo] -> [RoomInfo] -> IO () @@ -113,11 +115,12 @@ case r of Accept ci -> do let sameHostClients = filter (\cl -> host ci == host cl) clients - let haveJustConnected = not $ null $ filter (\cl -> connectTime ci `diffUTCTime` connectTime cl <= 5) sameHostClients + let haveJustConnected = not $ null $ filter (\cl -> connectTime ci `diffUTCTime` connectTime cl <= 25) sameHostClients when haveJustConnected $ do - atomically $ writeTChan (chan ci) ["QUIT", "Reconnected too fast"] - mainLoop acceptChan messagesChan (clients ++ [ci]) rooms + atomically $ do + --writeTChan (chan ci) ["ERROR", "Reconnected too fast"] + writeTChan (chan ci) ["QUIT", "Reconnected too fast"] mainLoop acceptChan messagesChan (clients ++ [ci]) rooms ClientMessage (cmd, client) -> do