# HG changeset patch # User unc0rr # Date 1235420707 0 # Node ID e901ec5644b49e79a5df917aaf82ffb53e14de6a # Parent 1fb61a53a2c2ce2a1e480ab0e586b9faf53bf55c Add options for configuring database access diff -r 1fb61a53a2c2 -r e901ec5644b4 gameServer/CoreTypes.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 diff -r 1fb61a53a2c2 -r e901ec5644b4 gameServer/OfficialServer/DBInteraction.hs --- 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 ()) diff -r 1fb61a53a2c2 -r e901ec5644b4 gameServer/ServerCore.hs --- 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) diff -r 1fb61a53a2c2 -r e901ec5644b4 gameServer/hedgewars-server.hs --- 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)