# HG changeset patch # User unc0rr # Date 1267122876 0 # Node ID 93cc73dcc421afda02c87303070e6e209f5eda59 # Parent ccb20ecd3503e5c7f00169e4c2239308c4164188 Replace tabs with spaces here too diff -r ccb20ecd3503 -r 93cc73dcc421 gameServer/OfficialServer/DBInteraction.hs --- a/gameServer/OfficialServer/DBInteraction.hs Thu Feb 25 18:34:30 2010 +0000 +++ b/gameServer/OfficialServer/DBInteraction.hs Thu Feb 25 18:34:36 2010 +0000 @@ -1,7 +1,7 @@ {-# LANGUAGE CPP, ScopedTypeVariables #-} module OfficialServer.DBInteraction ( - startDBConnection + startDBConnection ) where import Prelude hiding (catch); @@ -22,82 +22,82 @@ localAddressList = ["127.0.0.1", "0:0:0:0:0:0:0:1", "0:0:0:0:0:ffff:7f00:1"] fakeDbConnection serverInfo = do - q <- readChan $ dbQueries serverInfo - case q of - CheckAccount clUid _ clHost -> do - writeChan (coreChan serverInfo) $ ClientAccountInfo (clUid, - if clHost `elem` localAddressList then Admin else Guest) - ClearCache -> return () - SendStats {} -> return () + q <- readChan $ dbQueries serverInfo + case q of + CheckAccount clUid _ clHost -> do + writeChan (coreChan serverInfo) $ ClientAccountInfo (clUid, + if clHost `elem` localAddressList then Admin else Guest) + ClearCache -> return () + SendStats {} -> return () - fakeDbConnection serverInfo + fakeDbConnection serverInfo #if defined(OFFICIAL_SERVER) pipeDbConnectionLoop queries coreChan hIn hOut accountsCache = - Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return accountsCache) $ - do - q <- readChan queries - updatedCache <- case q of - CheckAccount clUid clNick _ -> do - let cacheEntry = clNick `Map.lookup` accountsCache - currentTime <- getCurrentTime - if (isNothing cacheEntry) || (currentTime `diffUTCTime` (fst . fromJust) cacheEntry > 2 * 24 * 60 * 60) then - do - hPutStrLn hIn $ show q - hFlush hIn + Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return accountsCache) $ + do + q <- readChan queries + updatedCache <- case q of + CheckAccount clUid clNick _ -> do + let cacheEntry = clNick `Map.lookup` accountsCache + currentTime <- getCurrentTime + if (isNothing cacheEntry) || (currentTime `diffUTCTime` (fst . fromJust) cacheEntry > 2 * 24 * 60 * 60) then + do + hPutStrLn hIn $ show q + hFlush hIn - (clId, accountInfo) <- hGetLine hOut >>= (maybeException . maybeRead) + (clId, accountInfo) <- hGetLine hOut >>= (maybeException . maybeRead) - writeChan coreChan $ ClientAccountInfo (clId, accountInfo) + writeChan coreChan $ ClientAccountInfo (clId, accountInfo) - return $ Map.insert clNick (currentTime, accountInfo) accountsCache - `Exception.onException` - (unGetChan queries q) - else - do - writeChan coreChan $ ClientAccountInfo (clUid, snd $ fromJust cacheEntry) - return accountsCache + return $ Map.insert clNick (currentTime, accountInfo) accountsCache + `Exception.onException` + (unGetChan queries q) + else + do + writeChan coreChan $ ClientAccountInfo (clUid, snd $ fromJust cacheEntry) + return accountsCache - ClearCache -> return Map.empty - SendStats {} -> ( - (hPutStrLn hIn $ show q) >> - hFlush hIn >> - return accountsCache) - `Exception.onException` - (unGetChan queries q) + ClearCache -> return Map.empty + SendStats {} -> ( + (hPutStrLn hIn $ show q) >> + hFlush hIn >> + return accountsCache) + `Exception.onException` + (unGetChan queries q) - pipeDbConnectionLoop queries coreChan hIn hOut updatedCache - where - maybeException (Just a) = return a - maybeException Nothing = ioError (userError "Can't read") + pipeDbConnectionLoop queries coreChan hIn hOut updatedCache + where + maybeException (Just a) = return a + maybeException Nothing = ioError (userError "Can't read") pipeDbConnection accountsCache serverInfo = do - updatedCache <- - Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return accountsCache) $ do - (Just hIn, Just hOut, _, _) <- createProcess (proc "./OfficialServer/extdbinterface" []) - {std_in = CreatePipe, - std_out = CreatePipe} - hSetBuffering hIn LineBuffering - hSetBuffering hOut LineBuffering + updatedCache <- + Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return accountsCache) $ do + (Just hIn, Just hOut, _, _) <- createProcess (proc "./OfficialServer/extdbinterface" []) + {std_in = CreatePipe, + std_out = CreatePipe} + hSetBuffering hIn LineBuffering + hSetBuffering hOut LineBuffering - hPutStrLn hIn $ dbHost serverInfo - hPutStrLn hIn $ dbLogin serverInfo - hPutStrLn hIn $ dbPassword serverInfo - pipeDbConnectionLoop (dbQueries serverInfo) (coreChan serverInfo) hIn hOut accountsCache + hPutStrLn hIn $ dbHost serverInfo + hPutStrLn hIn $ dbLogin serverInfo + hPutStrLn hIn $ dbPassword serverInfo + pipeDbConnectionLoop (dbQueries serverInfo) (coreChan serverInfo) hIn hOut accountsCache - threadDelay (3 * 10^6) - pipeDbConnection updatedCache serverInfo + threadDelay (3 * 10^6) + pipeDbConnection updatedCache serverInfo dbConnectionLoop serverInfo = - if (not . null $ dbHost serverInfo) then - pipeDbConnection Map.empty serverInfo - else - fakeDbConnection serverInfo + if (not . null $ dbHost serverInfo) then + pipeDbConnection Map.empty serverInfo + else + fakeDbConnection serverInfo #else dbConnectionLoop = fakeDbConnection #endif startDBConnection serverInfo = - forkIO $ dbConnectionLoop serverInfo + forkIO $ dbConnectionLoop serverInfo diff -r ccb20ecd3503 -r 93cc73dcc421 gameServer/OfficialServer/extdbinterface.hs --- a/gameServer/OfficialServer/extdbinterface.hs Thu Feb 25 18:34:30 2010 +0000 +++ b/gameServer/OfficialServer/extdbinterface.hs Thu Feb 25 18:34:36 2010 +0000 @@ -14,54 +14,54 @@ dbQueryAccount = - "select users.pass, users_roles.rid from users left join users_roles on users.uid = users_roles.uid where users.name = ?" + "SELECT users.pass, users_roles.rid FROM users LEFT JOIN users_roles ON users.uid = users_roles.uid WHERE users.name = ?" dbQueryStats = - "UPDATE gameserver_stats SET players = ?, rooms = ?, last_update = UNIX_TIMESTAMP()" + "UPDATE gameserver_stats SET players = ?, rooms = ?, last_update = UNIX_TIMESTAMP()" dbInteractionLoop dbConn = forever $ do - q <- (getLine >>= return . read) - hPutStrLn stderr $ show q - - case q of - CheckAccount clUid clNick _ -> do - statement <- prepare dbConn dbQueryAccount - execute statement [SqlString $ clNick] - passAndRole <- fetchRow statement - finish statement - let response = - if isJust passAndRole then - ( - clUid, - HasAccount - (fromSql $ head $ fromJust $ passAndRole) - ((fromSql $ last $ fromJust $ passAndRole) == (Just (3 :: Int))) - ) - else - (clUid, Guest) - putStrLn (show response) - hFlush stdout + q <- (getLine >>= return . read) + hPutStrLn stderr $ show q + + case q of + CheckAccount clUid clNick _ -> do + statement <- prepare dbConn dbQueryAccount + execute statement [SqlString $ clNick] + passAndRole <- fetchRow statement + finish statement + let response = + if isJust passAndRole then + ( + clUid, + HasAccount + (fromSql $ head $ fromJust $ passAndRole) + ((fromSql $ last $ fromJust $ passAndRole) == (Just (3 :: Int))) + ) + else + (clUid, Guest) + putStrLn (show response) + hFlush stdout - SendStats clients rooms -> - run dbConn dbQueryStats [SqlInt32 $ fromIntegral clients, SqlInt32 $ fromIntegral rooms] >> return () + SendStats clients rooms -> + run dbConn dbQueryStats [SqlInt32 $ fromIntegral clients, SqlInt32 $ fromIntegral rooms] >> return () dbConnectionLoop mySQLConnectionInfo = - Control.Exception.handle (\(_ :: IOException) -> return ()) $ handleSqlError $ - bracket - (connectMySQL mySQLConnectionInfo) - (disconnect) - (dbInteractionLoop) + Control.Exception.handle (\(_ :: IOException) -> return ()) $ handleSqlError $ + bracket + (connectMySQL mySQLConnectionInfo) + (disconnect) + (dbInteractionLoop) processRequest :: DBQuery -> IO String processRequest (CheckAccount clUid clNick clHost) = return $ show (clUid, Guest) main = do - dbHost <- getLine - dbLogin <- getLine - dbPassword <- getLine + dbHost <- getLine + dbLogin <- getLine + dbPassword <- getLine - let mySQLConnectInfo = defaultMySQLConnectInfo {mysqlHost = dbHost, mysqlDatabase = "hedge_main", mysqlUser = dbLogin, mysqlPassword = dbPassword} + let mySQLConnectInfo = defaultMySQLConnectInfo {mysqlHost = dbHost, mysqlDatabase = "hedge_main", mysqlUser = dbLogin, mysqlPassword = dbPassword} - dbConnectionLoop mySQLConnectInfo + dbConnectionLoop mySQLConnectInfo