gameServer/ServerCore.hs
changeset 1839 5dd4cb7fd7e5
parent 1833 e901ec5644b4
child 1841 fba7210b438b
--- a/gameServer/ServerCore.hs	Tue Feb 24 19:39:10 2009 +0000
+++ b/gameServer/ServerCore.hs	Tue Feb 24 19:39:49 2009 +0000
@@ -15,21 +15,24 @@
 import Actions
 import OfficialServer.DBInteraction
 
+
+firstAway (_, a, b, c) = (a, b, c)
+
 reactCmd :: ServerInfo -> Int -> [String] -> Clients -> Rooms -> IO (ServerInfo, Clients, Rooms)
 reactCmd serverInfo clID cmd clients rooms = do
 	(_ , serverInfo, clients, rooms) <-
 		foldM processAction (clID, serverInfo, clients, rooms) $ handleCmd clID clients rooms cmd
 	return (serverInfo, clients, rooms)
 
-mainLoop :: Chan CoreMessage -> ServerInfo -> Clients -> Rooms -> IO ()
-mainLoop coreChan serverInfo clients rooms = do
-	r <- readChan coreChan
+mainLoop :: ServerInfo -> Clients -> Rooms -> IO ()
+mainLoop serverInfo clients rooms = do
+	r <- readChan $ coreChan serverInfo
 	
 	(newServerInfo, mClients, mRooms) <-
 		case r of
 			Accept ci -> do
 				let updatedClients = IntMap.insert (clientUID ci) ci clients
-				--infoM "Clients" ("New client: id " ++ (show $ clientUID ci))
+				infoM "Clients" ("New client: id " ++ (show $ clientUID ci))
 				processAction
 					(clientUID ci, serverInfo, updatedClients, rooms)
 					(AnswerThisClient ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"])
@@ -44,11 +47,22 @@
 					debugM "Clients" "Message from dead client"
 					return (serverInfo, clients, rooms)
 
+			ClientAccountInfo clID info ->
+				if clID `IntMap.member` clients then
+					liftM firstAway $ processAction
+						(clID, serverInfo, clients, rooms)
+						(ProcessAccountInfo info)
+					else
+					do
+					debugM "Clients" "Got info for dead client"
+					return (serverInfo, clients, rooms)
+			
+
 	{-			let hadRooms = (not $ null rooms) && (null mrooms)
 					in unless ((not $ isDedicated serverInfo) && ((null clientsIn) || hadRooms)) $
 						mainLoop serverInfo acceptChan messagesChan clientsIn mrooms -}
 
-	mainLoop coreChan newServerInfo mClients mRooms
+	mainLoop newServerInfo mClients mRooms
 
 startServer :: ServerInfo -> Chan CoreMessage -> Socket -> IO ()
 startServer serverInfo coreChan serverSocket = do
@@ -67,7 +81,7 @@
 
 	startDBConnection $ serverInfo
 
-	mainLoop coreChan serverInfo IntMap.empty (IntMap.singleton 0 newRoom)
+	mainLoop serverInfo IntMap.empty (IntMap.singleton 0 newRoom)