Add options for configuring database access
authorunc0rr
Mon, 23 Feb 2009 20:25:07 +0000
changeset 1833 e901ec5644b4
parent 1832 1fb61a53a2c2
child 1834 71cb978dc85f
Add options for configuring database access
gameServer/CoreTypes.hs
gameServer/OfficialServer/DBInteraction.hs
gameServer/ServerCore.hs
gameServer/hedgewars-server.hs
--- a/gameServer/CoreTypes.hs	Mon Feb 23 20:15:02 2009 +0000
+++ b/gameServer/CoreTypes.hs	Mon Feb 23 20:25:07 2009 +0000
@@ -10,6 +10,7 @@
 import Data.Sequence(Seq, empty)
 import Network
 
+
 data ClientInfo =
  ClientInfo
 	{
@@ -104,10 +105,6 @@
 		roomsNumber :: Int
 	}
 
-data DBQuery =
-	HasRegistered String
-	| CheckPassword String
-
 data ServerInfo =
 	ServerInfo
 	{
@@ -119,8 +116,8 @@
 		dbHost :: String,
 		dbLogin :: String,
 		dbPassword :: String,
-		stats :: TMVar StatisticsInfo
-		--dbQueries :: TChan DBQuery
+		stats :: TMVar StatisticsInfo,
+		dbQueries :: Chan DBQuery
 	}
 
 instance Show ServerInfo where
@@ -144,6 +141,10 @@
 	-- | CoreMessage String
 	-- | TimerTick
 
+data DBQuery =
+	HasRegistered String
+	| CheckPassword String
+
 
 type Clients = IntMap.IntMap ClientInfo
 type Rooms = IntMap.IntMap RoomInfo
--- a/gameServer/OfficialServer/DBInteraction.hs	Mon Feb 23 20:15:02 2009 +0000
+++ b/gameServer/OfficialServer/DBInteraction.hs	Mon Feb 23 20:25:07 2009 +0000
@@ -6,32 +6,30 @@
 
 import Database.HDBC
 import Database.HDBC.MySQL
-
 import System.IO
 import Control.Concurrent
-import Control.Concurrent.STM
 import Control.Exception
-
-data DBQuery =
-	HasRegistered String
-	| CheckPassword String
+import Monad
+------------------------
+import CoreTypes
 
 dbInteractionLoop queries dbConn = do
-	q <- atomically $ readTChan queries
+	q <- readChan queries
 	case q of
 		HasRegistered queryStr -> putStrLn queryStr
 		CheckPassword queryStr -> putStrLn queryStr
 
 	dbInteractionLoop queries dbConn
 
-dbConnectionLoop queries = do
+dbConnectionLoop serverInfo = do
 	Control.Exception.handle (\e -> print e) $ handleSqlError $
 		bracket
-			(connectMySQL defaultMySQLConnectInfo { mysqlHost = "192.168.50.5", mysqlDatabase = "glpi" })
+			(connectMySQL defaultMySQLConnectInfo {mysqlHost = dbHost serverInfo, mysqlDatabase = "hedge_main", mysqlUser = dbLogin serverInfo, mysqlPassword = dbPassword serverInfo })
 			(disconnect)
-			(dbInteractionLoop queries)
+			(dbInteractionLoop $ dbQueries serverInfo)
 
 	threadDelay (15 * 10^6)
-	dbConnectionLoop queries
+	dbConnectionLoop serverInfo
 
-startDBConnection queries = forkIO $ dbConnectionLoop queries
+startDBConnection serverInfo =
+	when (not . null $ dbHost serverInfo) ((forkIO $ dbConnectionLoop serverInfo) >> return ())
--- a/gameServer/ServerCore.hs	Mon Feb 23 20:15:02 2009 +0000
+++ b/gameServer/ServerCore.hs	Mon Feb 23 20:25:07 2009 +0000
@@ -13,6 +13,7 @@
 import Utils
 import HWProtoCore
 import Actions
+import OfficialServer.DBInteraction
 
 reactCmd :: ServerInfo -> Int -> [String] -> Clients -> Rooms -> IO (ServerInfo, Clients, Rooms)
 reactCmd serverInfo clID cmd clients rooms = do
@@ -64,7 +65,7 @@
 {-	forkIO $ messagesLoop messagesChan
 	forkIO $ timerLoop messagesChan-}
 
---	startDBConnection $ dbQueries serverInfo
+	startDBConnection $ serverInfo
 
 	mainLoop coreChan serverInfo IntMap.empty (IntMap.singleton 0 newRoom)
 
--- a/gameServer/hedgewars-server.hs	Mon Feb 23 20:15:02 2009 +0000
+++ b/gameServer/hedgewars-server.hs	Mon Feb 23 20:25:07 2009 +0000
@@ -48,9 +48,9 @@
 	setupLoggers
 
 	stats <- atomically $ newTMVar (StatisticsInfo 0 0)
-	--dbQueriesChan <- atomically newTChan
+	dbQueriesChan <- newChan
 	coreChan <- newChan
-	serverInfo <- getOpts $ newServerInfo stats -- dbQueriesChan
+	serverInfo <- getOpts $ newServerInfo stats dbQueriesChan
 	
 	bracket
 		(Network.listenOn $ Network.PortNumber $ listenPort serverInfo)