Mercurial Mercurial > hedgewars / diff
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
netserver/hedgewars-server.hs
changeset 1483 89e24edb6020
parent 1482 8af42b3f93d2
child 1484 c01512115c12 
--- 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
hedgewars