Make code flow more clear
authorunc0rr
Fri, 07 Nov 2008 22:03:43 +0000
changeset 1483 89e24edb6020
parent 1482 8af42b3f93d2
child 1484 c01512115c12
Make code flow more clear
netserver/HWProto.hs
netserver/hedgewars-server.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
--- 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