Fix build of official server
authorunc0rr
Sat, 05 Feb 2011 23:15:22 +0300
changeset 4921 2efad3acbb74
parent 4920 bc3c077e15a2
child 4922 89777ce0d273
Fix build of official server
gameServer/OfficialServer/DBInteraction.hs
gameServer/OfficialServer/extdbinterface.hs
gameServer/Utils.hs
gameServer/hedgewars-server.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
--- 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
--- 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)
--- 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)