--- 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

--- 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
 

--- 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

--- /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

--- 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)