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