diff -r 1c85a8e6e11c -r 21d6b2b79cfe gameServer/OfficialServer/DBInteraction.hs --- 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