# HG changeset patch # User unc0rr # Date 1243265067 0 # Node ID dec7ead2d17853ec35d2615bbfa1bcf73b0fd97c # Parent 1c9a8081aef68b8c728904b3441c87f63f8e9f9a Bring back authentication to official server, now using separate process to perform database interaction diff -r 1c9a8081aef6 -r dec7ead2d178 gameServer/Actions.hs --- a/gameServer/Actions.hs Sun May 24 19:49:10 2009 +0000 +++ b/gameServer/Actions.hs Mon May 25 15:24:27 2009 +0000 @@ -289,7 +289,7 @@ processAction (clID, serverInfo, clients, rooms) (CheckRegistered) = do - writeChan (dbQueries serverInfo) $ CheckAccount client + writeChan (dbQueries serverInfo) $ CheckAccount (clientUID client) (nick client) (host client) return (clID, serverInfo, clients, rooms) where client = clients ! clID diff -r 1c9a8081aef6 -r dec7ead2d178 gameServer/CoreTypes.hs --- a/gameServer/CoreTypes.hs Sun May 24 19:49:10 2009 +0000 +++ b/gameServer/CoreTypes.hs Mon May 25 15:24:27 2009 +0000 @@ -148,17 +148,18 @@ HasAccount String Bool | Guest | Admin + deriving (Show, Read) + +data DBQuery = + CheckAccount Int String String + deriving (Show, Read) data CoreMessage = Accept ClientInfo | ClientMessage (Int, [String]) - | ClientAccountInfo Int AccountInfo + | ClientAccountInfo (Int, AccountInfo) | TimerAction -data DBQuery = - CheckAccount ClientInfo - - type Clients = IntMap.IntMap ClientInfo type Rooms = IntMap.IntMap RoomInfo diff -r 1c9a8081aef6 -r dec7ead2d178 gameServer/OfficialServer/DBInteraction.hs --- a/gameServer/OfficialServer/DBInteraction.hs Sun May 24 19:49:10 2009 +0000 +++ b/gameServer/OfficialServer/DBInteraction.hs Mon May 25 15:24:27 2009 +0000 @@ -4,33 +4,32 @@ startDBConnection ) where -#if defined(OFFICIAL_SERVER) -import Database.HDBC -import Database.HDBC.MySQL -#endif - import Prelude hiding (catch); +import System.Process import System.IO import Control.Concurrent import Control.Exception +import Control.Monad import Monad import Maybe import System.Log.Logger ------------------------ import CoreTypes +import Utils 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 client -> do - writeChan (coreChan serverInfo) $ ClientAccountInfo (clientUID client) $ - if host client `elem` localAddressList then Admin else Guest + CheckAccount clUid _ clHost -> do + writeChan (coreChan serverInfo) $ ClientAccountInfo (clUid, + if clHost `elem` localAddressList then Admin else Guest) fakeDbConnection serverInfo +#if defined(OFFICIAL_SERVER) ------------------------------------------------------------------- -- borrowed from base 4.0.0 --------------------------------------- onException :: IO a -> IO b -> IO a -- @@ -39,40 +38,40 @@ -- to be deleted -------------------------------------------------- ------------------------------------------------------------------- -#if defined(OFFICIAL_SERVER) -dbQueryString = - "select users.pass, users_roles.rid from users left join users_roles on users.uid = users_roles.uid where users.name = ?" -dbInteractionLoop queries coreChan dbConn = do +pipeDbConnectionLoop queries coreChan hIn hOut = do q <- readChan queries - case q of - CheckAccount client -> do - statement <- prepare dbConn dbQueryString - execute statement [SqlString $ nick client] - passAndRole <- fetchRow statement - finish statement - if isJust passAndRole then - writeChan coreChan $ - ClientAccountInfo (clientUID client) $ - HasAccount - (fromSql $ head $ fromJust $ passAndRole) - ((fromSql $ last $ fromJust $ passAndRole) == (Just (3 :: Int))) - else - writeChan coreChan $ ClientAccountInfo (clientUID client) Guest - `onException` - (unGetChan queries q) + do + hPutStrLn hIn $ show q + hFlush hIn + + response <- hGetLine hOut >>= (maybeException . maybeRead) + + writeChan coreChan $ ClientAccountInfo response + `onException` + (unGetChan queries q) + where + maybeException (Just a) = return a + maybeException Nothing = ioError (userError "Can't read") - dbInteractionLoop queries coreChan dbConn + +pipeDbConnection serverInfo = forever $ do + Control.Exception.handle (\e -> warningM "Database" $ show e) $ do + (Just hIn, Just hOut, _, _) <- + createProcess (proc "./OfficialServer/extdbinterface" []) {std_in = CreatePipe, std_out = CreatePipe } -dbConnectionLoop serverInfo = do - Control.Exception.handle (\e -> infoM "Database" $ show e) $ handleSqlError $ - bracket - (connectMySQL defaultMySQLConnectInfo {mysqlHost = dbHost serverInfo, mysqlDatabase = "hedge_main", mysqlUser = dbLogin serverInfo, mysqlPassword = dbPassword serverInfo }) - (disconnect) - (dbInteractionLoop (dbQueries serverInfo) (coreChan serverInfo)) + 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 threadDelay (5 * 10^6) - dbConnectionLoop serverInfo + + +dbConnectionLoop = pipeDbConnection #else dbConnectionLoop = fakeDbConnection #endif @@ -81,4 +80,5 @@ if (not . null $ dbHost serverInfo) then forkIO $ dbConnectionLoop serverInfo else - forkIO $ fakeDbConnection serverInfo + --forkIO $ fakeDbConnection serverInfo + forkIO $ pipeDbConnection serverInfo diff -r 1c9a8081aef6 -r dec7ead2d178 gameServer/OfficialServer/extdbinterface.hs --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/gameServer/OfficialServer/extdbinterface.hs Mon May 25 15:24:27 2009 +0000 @@ -0,0 +1,57 @@ +module Main where + +import Prelude hiding (catch); +import Control.Monad +import Control.Exception +import System.IO +import Maybe +import Database.HDBC +import Database.HDBC.MySQL +-------------------------- +import CoreTypes + + +dbQueryString = + "select users.pass, users_roles.rid from users left join users_roles on users.uid = users_roles.uid where users.name = ?" + +dbInteractionLoop dbConn = forever $ do + q <- (getLine >>= return . read) + + response <- case q of + CheckAccount clUid clNick _ -> do + statement <- prepare dbConn dbQueryString + execute statement [SqlString $ clNick] + passAndRole <- fetchRow statement + finish statement + if isJust passAndRole then + return $ ( + clUid, + HasAccount + (fromSql $ head $ fromJust $ passAndRole) + ((fromSql $ last $ fromJust $ passAndRole) == (Just (3 :: Int))) + ) + else + return $ (clUid, Guest) + + putStrLn (show response) + hFlush stdout + +dbConnectionLoop mySQLConnectionInfo = + Control.Exception.handle (\e -> 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 + + let mySQLConnectInfo = defaultMySQLConnectInfo {mysqlHost = dbHost, mysqlDatabase = "hedge_main", mysqlUser = dbLogin, mysqlPassword = dbPassword} + + dbConnectionLoop mySQLConnectInfo diff -r 1c9a8081aef6 -r dec7ead2d178 gameServer/ServerCore.hs --- a/gameServer/ServerCore.hs Sun May 24 19:49:10 2009 +0000 +++ b/gameServer/ServerCore.hs Mon May 25 15:24:27 2009 +0000 @@ -46,7 +46,7 @@ debugM "Clients" "Message from dead client" return (serverInfo, clients, rooms) - ClientAccountInfo clID info -> + ClientAccountInfo (clID, info) -> if clID `IntMap.member` clients then liftM firstAway $ processAction (clID, serverInfo, clients, rooms)