# HG changeset patch # User unc0rr # Date 1296936922 -10800 # Node ID 2efad3acbb74553a5e9bea867a577c471ec0bb37 # Parent bc3c077e15a254e41c4e540c3875a2bad4de2efe Fix build of official server diff -r bc3c077e15a2 -r 2efad3acbb74 gameServer/OfficialServer/DBInteraction.hs --- a/gameServer/OfficialServer/DBInteraction.hs Sat Feb 05 15:45:44 2011 +0100 +++ b/gameServer/OfficialServer/DBInteraction.hs Sat Feb 05 23:15:22 2011 +0300 @@ -6,7 +6,7 @@ import Prelude hiding (catch); import System.Process -import System.IO +import System.IO as SIO import Control.Concurrent import qualified Control.Exception as Exception import Control.Monad @@ -14,6 +14,8 @@ import Data.Maybe import System.Log.Logger import Data.Time +import Data.ByteString.Char8 as B +import Data.List as L ------------------------ import CoreTypes import Utils @@ -24,7 +26,7 @@ q <- readChan $ dbQueries serverInfo case q of CheckAccount clId clUid _ clHost -> do - writeChan (coreChan serverInfo) $ ClientAccountInfo clId clUid (if clHost `elem` localAddressList then Admin else Guest) + writeChan (coreChan serverInfo) $ ClientAccountInfo clId clUid (if clHost `L.elem` localAddressList then Admin else Guest) ClearCache -> return () SendStats {} -> return () @@ -35,29 +37,29 @@ do q <- readChan queries updatedCache <- case q of - CheckAccount clId clNick _ -> do + CheckAccount clId 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 + SIO.hPutStrLn hIn $ show q hFlush hIn - (clId', accountInfo) <- hGetLine hOut >>= (maybeException . maybeRead) + (clId', clUid', accountInfo) <- SIO.hGetLine hOut >>= (maybeException . maybeRead) - writeChan coreChan $ ClientAccountInfo (clId', accountInfo) + writeChan coreChan $ ClientAccountInfo clId' clUid' accountInfo return $ Map.insert clNick (currentTime, accountInfo) accountsCache `Exception.onException` (unGetChan queries q) else do - writeChan coreChan $ ClientAccountInfo (clId, snd $ fromJust cacheEntry) + writeChan coreChan $ ClientAccountInfo clId clUid (snd $ fromJust cacheEntry) return accountsCache ClearCache -> return Map.empty SendStats {} -> ( - (hPutStrLn hIn $ show q) >> + (SIO.hPutStrLn hIn $ show q) >> hFlush hIn >> return accountsCache) `Exception.onException` @@ -69,7 +71,7 @@ maybeException Nothing = ioError (userError "Can't read") -pipeDbConnection accountsCache serverInfo = do +pipeDbConnection accountsCache si = do updatedCache <- Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return accountsCache) $ do (Just hIn, Just hOut, _, _) <- createProcess (proc "./OfficialServer/extdbinterface" []) @@ -78,19 +80,19 @@ 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 + B.hPutStrLn hIn $ dbHost si + B.hPutStrLn hIn $ dbLogin si + B.hPutStrLn hIn $ dbPassword si + pipeDbConnectionLoop (dbQueries si) (coreChan si) hIn hOut accountsCache threadDelay (3 * 10^6) - pipeDbConnection updatedCache serverInfo + pipeDbConnection updatedCache si -dbConnectionLoop serverInfo = - if (not . null $ dbHost serverInfo) then - pipeDbConnection Map.empty serverInfo +dbConnectionLoop si = + if (not . B.null $ dbHost si) then + pipeDbConnection Map.empty si else - fakeDbConnection serverInfo + fakeDbConnection si #else dbConnectionLoop = fakeDbConnection #endif diff -r bc3c077e15a2 -r 2efad3acbb74 gameServer/OfficialServer/extdbinterface.hs --- a/gameServer/OfficialServer/extdbinterface.hs Sat Feb 05 15:45:44 2011 +0100 +++ b/gameServer/OfficialServer/extdbinterface.hs Sat Feb 05 23:15:22 2011 +0300 @@ -22,9 +22,9 @@ dbInteractionLoop dbConn = forever $ do q <- (getLine >>= return . read) hPutStrLn stderr $ show q - + case q of - CheckAccount clUid clNick _ -> do + CheckAccount clId clUid clNick _ -> do statement <- prepare dbConn dbQueryAccount execute statement [SqlByteString $ clNick] passAndRole <- fetchRow statement @@ -32,13 +32,14 @@ let response = if isJust passAndRole then ( + clId, clUid, HasAccount (fromSql $ head $ fromJust $ passAndRole) ((fromSql $ last $ fromJust $ passAndRole) == (Just (3 :: Int))) ) else - (clUid, Guest) + (clId, clUid, Guest) putStrLn (show response) hFlush stdout @@ -54,8 +55,8 @@ (dbInteractionLoop) -processRequest :: DBQuery -> IO String -processRequest (CheckAccount clUid clNick clHost) = return $ show (clUid, Guest) +--processRequest :: DBQuery -> IO String +--processRequest (CheckAccount clId clUid clNick clHost) = return $ show (clclId, clUid, Guest) main = do dbHost <- getLine diff -r bc3c077e15a2 -r 2efad3acbb74 gameServer/Utils.hs --- a/gameServer/Utils.hs Sat Feb 05 15:45:44 2011 +0100 +++ b/gameServer/Utils.hs Sat Feb 05 23:15:22 2011 +0300 @@ -107,11 +107,11 @@ (37, "0.9.15"), (38, "0.9.16-dev")] -askFromConsole :: String -> IO String +askFromConsole :: B.ByteString -> IO B.ByteString askFromConsole msg = do - putStr msg + B.putStr msg hFlush stdout - getLine + B.getLine unfoldrE :: (b -> Either b (a, b)) -> b -> ([a], b) diff -r bc3c077e15a2 -r 2efad3acbb74 gameServer/hedgewars-server.hs --- a/gameServer/hedgewars-server.hs Sat Feb 05 15:45:44 2011 +0100 +++ b/gameServer/hedgewars-server.hs Sat Feb 05 23:15:22 2011 +0300 @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, ScopedTypeVariables #-} +{-# LANGUAGE CPP, ScopedTypeVariables, OverloadedStrings #-} module Main where @@ -12,6 +12,9 @@ import Opts import CoreTypes import ServerCore +#if defined(OFFICIAL_SERVER) +import Utils +#endif #if !defined(mingw32_HOST_OS)