# HG changeset patch
# User unc0rr
# Date 1238185778 0
# Node ID e2031906a347b8f2e687982ed70ede8afae6a4e5
# Parent  cb46fbdcaa41b10c07646019dbfaacf4e8da86b8
Ping clients every 30 seconds. Disconnection due to ping timeout to be implemented.

diff -r cb46fbdcaa41 -r e2031906a347 gameServer/Actions.hs
--- a/gameServer/Actions.hs	Fri Mar 27 18:50:18 2009 +0000
+++ b/gameServer/Actions.hs	Fri Mar 27 20:29:38 2009 +0000
@@ -42,6 +42,7 @@
 	| ProcessAccountInfo AccountInfo
 	| Dump
 	| AddClient ClientInfo
+	| PingAll
 
 type CmdHandler = Int -> Clients -> Rooms -> [String] -> [Action]
 
@@ -56,7 +57,7 @@
 
 
 processAction (clID, serverInfo, clients, rooms) (AnswerAll msg) = do
-	mapM_ (\id -> writeChan (sendChan $ clients ! id) msg) (keys clients)
+	mapM_ (\cl -> writeChan (sendChan cl) msg) (elems clients)
 	return (clID, serverInfo, clients, rooms)
 
 
@@ -330,7 +331,7 @@
 
 processAction (clID, serverInfo, clients, rooms) (AddClient client) = do
 	let updatedClients = insert (clientUID client) client clients
-	infoM "Clients" ((show $ clientUID client) ++ ": new client. Time: " ++ (show $ connectTime client))
+	infoM "Clients" ((show $ clientUID client) ++ ": New client. Time: " ++ (show $ connectTime client))
 	writeChan (sendChan $ client) ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"]
 
 	let newLogins = takeWhile (\(_ , time) -> (connectTime client) `diffUTCTime` time <= 20) $ lastLogins serverInfo
@@ -339,3 +340,11 @@
 		processAction (clID, serverInfo{lastLogins = newLogins}, updatedClients, rooms) $ ByeClient "Reconnected too fast"
 		else
 		return (clID, serverInfo{lastLogins = (host client, connectTime client) : newLogins}, updatedClients, rooms)
+
+
+processAction (clID, serverInfo, clients, rooms) PingAll = do
+	processAction (clID,
+		serverInfo,
+		map (\cl -> cl{pingsQueue = pingsQueue cl + 1}) clients,
+		rooms) $ AnswerAll ["PING"]
+
diff -r cb46fbdcaa41 -r e2031906a347 gameServer/CoreTypes.hs
--- a/gameServer/CoreTypes.hs	Fri Mar 27 18:50:18 2009 +0000
+++ b/gameServer/CoreTypes.hs	Fri Mar 27 20:29:38 2009 +0000
@@ -25,6 +25,7 @@
 		logonPassed :: Bool,
 		clientProto :: Word16,
 		roomID :: Int,
+		pingsQueue :: Word,
 		isMaster :: Bool,
 		isReady :: Bool,
 		isAdministrator :: Bool,
@@ -152,8 +153,7 @@
 	Accept ClientInfo
 	| ClientMessage (Int, [String])
 	| ClientAccountInfo Int AccountInfo
-	-- | CoreMessage String
-	-- | TimerTick
+	| TimerAction
 
 data DBQuery =
 	CheckAccount ClientInfo
diff -r cb46fbdcaa41 -r e2031906a347 gameServer/NetRoutines.hs
--- a/gameServer/NetRoutines.hs	Fri Mar 27 18:50:18 2009 +0000
+++ b/gameServer/NetRoutines.hs	Fri Mar 27 20:29:38 2009 +0000
@@ -41,6 +41,7 @@
 					False
 					0
 					0
+					0
 					False
 					False
 					False
diff -r cb46fbdcaa41 -r e2031906a347 gameServer/ServerCore.hs
--- a/gameServer/ServerCore.hs	Fri Mar 27 18:50:18 2009 +0000
+++ b/gameServer/ServerCore.hs	Fri Mar 27 20:29:38 2009 +0000
@@ -16,6 +16,11 @@
 import OfficialServer.DBInteraction
 
 
+timerLoop :: Chan CoreMessage -> IO()
+timerLoop messagesChan = forever $ do
+	threadDelay (30 * 10^6) -- 30 seconds
+	writeChan messagesChan TimerAction
+
 firstAway (_, a, b, c) = (a, b, c)
 
 reactCmd :: ServerInfo -> Int -> [String] -> Clients -> Rooms -> IO (ServerInfo, Clients, Rooms)
@@ -50,6 +55,11 @@
 					do
 					debugM "Clients" "Got info for dead client"
 					return (serverInfo, clients, rooms)
+
+			TimerAction ->
+				liftM firstAway $ processAction
+						(0, serverInfo, clients, rooms)
+						PingAll
 			
 
 	{-			let hadRooms = (not $ null rooms) && (null mrooms)
@@ -58,20 +68,19 @@
 
 	mainLoop newServerInfo mClients mRooms
 
-startServer :: ServerInfo -> Chan CoreMessage -> Socket -> IO ()
-startServer serverInfo coreChan serverSocket = do
+startServer :: ServerInfo -> Socket -> IO ()
+startServer serverInfo serverSocket = do
 	putStrLn $ "Listening on port " ++ show (listenPort serverInfo)
 
 	forkIO $
 		acceptLoop
 			serverSocket
-			coreChan
+			(coreChan serverInfo)
 			0
 
 	return ()
 	
-{-	forkIO $ messagesLoop messagesChan
-	forkIO $ timerLoop messagesChan-}
+	forkIO $ timerLoop $ coreChan serverInfo
 
 	startDBConnection $ serverInfo
 
diff -r cb46fbdcaa41 -r e2031906a347 gameServer/hedgewars-server.hs
--- a/gameServer/hedgewars-server.hs	Fri Mar 27 18:50:18 2009 +0000
+++ b/gameServer/hedgewars-server.hs	Fri Mar 27 20:29:38 2009 +0000
@@ -20,22 +20,6 @@
 #endif
 
 
-{-data Messages =
-	Accept ClientInfo
-	| ClientMessage ([String], ClientInfo)
-	| CoreMessage [String]
-	| TimerTick
-
-messagesLoop :: TChan String -> IO()
-messagesLoop messagesChan = forever $ do
-	threadDelay (25 * 10^6) -- 25 seconds
-	atomically $ writeTChan messagesChan "PING"
-
-timerLoop :: TChan String -> IO()
-timerLoop messagesChan = forever $ do
-	threadDelay (60 * 10^6) -- 60 seconds
-	atomically $ writeTChan messagesChan "MINUTELY"-}
-
 setupLoggers =
 	updateGlobalLogger "Clients"
 		(setLevel DEBUG)
@@ -55,4 +39,4 @@
 	bracket
 		(Network.listenOn $ Network.PortNumber $ listenPort serverInfo)
 		(sClose)
-		(startServer serverInfo coreChan)
+		(startServer serverInfo)