--- a/gameServer/OfficialServer/DBInteraction.hs Wed Feb 16 12:07:30 2011 +0300
+++ b/gameServer/OfficialServer/DBInteraction.hs Wed Feb 16 12:49:12 2011 +0300
@@ -28,17 +28,30 @@
localAddressList = ["127.0.0.1", "0:0:0:0:0:0:0:1", "0:0:0:0:0:ffff:7f00:1"]
fakeDbConnection :: forall b. ServerInfo -> IO b
-fakeDbConnection serverInfo = forever $ do
- q <- readChan $ dbQueries serverInfo
+fakeDbConnection si = forever $ do
+ q <- readChan $ dbQueries si
case q of
CheckAccount clId clUid _ clHost ->
- writeChan (coreChan serverInfo) $ ClientAccountInfo clId clUid (if clHost `L.elem` localAddressList then Admin else Guest)
+ writeChan (coreChan si) $ ClientAccountInfo clId clUid (if clHost `L.elem` localAddressList then Admin else Guest)
ClearCache -> return ()
SendStats {} -> return ()
dbConnectionLoop :: forall b. ServerInfo -> IO b
#if defined(OFFICIAL_SERVER)
-pipeDbConnectionLoop queries coreChan hIn hOut accountsCache =
+flushRequests :: ServerInfo -> IO ()
+flushRequests si = do
+ e <- isEmptyChan $ dbQueries si
+ unless e $ do
+ q <- readChan $ dbQueries si
+ case q of
+ CheckAccount clId clUid _ clHost ->
+ writeChan (coreChan si) $ ClientAccountInfo clId clUid (if clHost `L.elem` localAddressList then Admin else Guest)
+ ClearCache -> return ()
+ SendStats {} -> return ()
+ flushRequests si
+
+pipeDbConnectionLoop :: Chan DBQuery -> Chan CoreMessage -> Handle -> Handle -> Map.Map ByteString (UTCTime, AccountInfo) -> IO (Map.Map ByteString (UTCTime, AccountInfo))
+pipeDbConnectionLoop queries cChan hIn hOut accountsCache =
Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return accountsCache) $
do
q <- readChan queries
@@ -53,14 +66,16 @@
(clId', clUid', accountInfo) <- SIO.hGetLine hOut >>= (maybeException . maybeRead)
- writeChan coreChan $ ClientAccountInfo clId' clUid' accountInfo
+ writeChan cChan $ ClientAccountInfo clId' clUid' accountInfo
return $ Map.insert clNick (currentTime, accountInfo) accountsCache
`Exception.onException`
- (unGetChan queries q)
+ (unGetChan queries q
+ >> writeChan cChan (ClientAccountInfo clId clUid Guest)
+ )
else
do
- writeChan coreChan $ ClientAccountInfo clId clUid (snd $ fromJust cacheEntry)
+ writeChan cChan $ ClientAccountInfo clId clUid (snd $ fromJust cacheEntry)
return accountsCache
ClearCache -> return Map.empty
@@ -71,15 +86,15 @@
`Exception.onException`
(unGetChan queries q)
- pipeDbConnectionLoop queries coreChan hIn hOut updatedCache
+ pipeDbConnectionLoop queries cChan hIn hOut updatedCache
where
maybeException (Just a) = return a
maybeException Nothing = ioError (userError "Can't read")
-
-pipeDbConnection accountsCache si = do
- updatedCache <-
- Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return accountsCache) $ do
+pipeDbConnection :: forall b. Map.Map ByteString (UTCTime, AccountInfo) -> ServerInfo -> Int -> IO b
+pipeDbConnection accountsCache si errNum = do
+ (updatedCache, newErrNum) <-
+ Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return (accountsCache, errNum + 1)) $ do
(Just hIn, Just hOut, _, _) <- createProcess (proc "./OfficialServer/extdbinterface" [])
{std_in = CreatePipe,
std_out = CreatePipe}
@@ -89,14 +104,16 @@
B.hPutStrLn hIn $ dbHost si
B.hPutStrLn hIn $ dbLogin si
B.hPutStrLn hIn $ dbPassword si
- pipeDbConnectionLoop (dbQueries si) (coreChan si) hIn hOut accountsCache
+ c <- pipeDbConnectionLoop (dbQueries si) (coreChan si) hIn hOut accountsCache
+ return (c, 0)
- threadDelay (3 * 10^6)
- pipeDbConnection updatedCache si
+ when (newErrNum > 1) $ flushRequests si
+ threadDelay (3000000)
+ pipeDbConnection updatedCache si newErrNum
dbConnectionLoop si =
if (not . B.null $ dbHost si) then
- pipeDbConnection Map.empty si
+ pipeDbConnection Map.empty si 0
else
fakeDbConnection si
#else