# HG changeset patch # User unc0rr # Date 1301760080 -14400 # Node ID 7915668502a6b55b1160f311df83aa7c7d3c4432 # Parent 59b13b38a827acbf7d77797d9c53c1ba296909ea Some fixes. Can't reproduce ghosts now. diff -r 59b13b38a827 -r 7915668502a6 gameServer/Actions.hs --- a/gameServer/Actions.hs Tue Mar 29 20:10:56 2011 -0400 +++ b/gameServer/Actions.hs Sat Apr 02 20:01:20 2011 +0400 @@ -395,7 +395,7 @@ si <- gets serverInfo newClId <- io $ do ci <- addClient rnc cl - _ <- Exception.block . forkIO $ clientRecvLoop (clientSocket cl) (coreChan si) (sendChan cl) ci + _ <- Exception.mask (forkIO . clientRecvLoop (clientSocket cl) (coreChan si) (sendChan cl) ci) infoM "Clients" (show ci ++ ": New client. Time: " ++ show (connectTime cl)) diff -r 59b13b38a827 -r 7915668502a6 gameServer/ClientIO.hs --- a/gameServer/ClientIO.hs Tue Mar 29 20:10:56 2011 -0400 +++ b/gameServer/ClientIO.hs Sat Apr 02 20:01:20 2011 +0400 @@ -1,4 +1,4 @@ -{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables, OverloadedStrings, Rank2Types #-} module ClientIO where import qualified Control.Exception as Exception @@ -30,7 +30,7 @@ return (B.splitWith (== '\n') packet : packets) listenLoop :: Socket -> Chan CoreMessage -> ClientIndex -> IO () -listenLoop sock chan ci = Exception.unblock $ recieveWithBufferLoop B.empty +listenLoop sock chan ci = recieveWithBufferLoop B.empty where recieveWithBufferLoop recvBuf = do recvBS <- recv sock 4096 @@ -41,11 +41,11 @@ sendPacket packet = writeChan chan $ ClientMessage (ci, packet) -clientRecvLoop :: Socket -> Chan CoreMessage -> Chan [B.ByteString] -> ClientIndex -> IO () -clientRecvLoop s chan clChan ci = +clientRecvLoop :: Socket -> Chan CoreMessage -> Chan [B.ByteString] -> ClientIndex -> (forall a. IO a -> IO a) -> IO () +clientRecvLoop s chan clChan ci restore = myThreadId >>= - \t -> forkIO (clientSendLoop s t clChan ci) >> - (listenLoop s chan ci >> return "Connection closed") + \t -> (restore $ forkIO (clientSendLoop s t clChan ci) >> + listenLoop s chan ci >> return "Connection closed") `Exception.catch` (\(e :: Exception.IOException) -> return . B.pack . show $ e) `Exception.catch` (\(e :: ShutdownThreadException) -> return . B.pack . show $ e) >>= clientOff >> remove diff -r 59b13b38a827 -r 7915668502a6 gameServer/hedgewars-server.cabal --- a/gameServer/hedgewars-server.cabal Tue Mar 29 20:10:56 2011 -0400 +++ b/gameServer/hedgewars-server.cabal Sat Apr 02 20:01:20 2011 +0400 @@ -15,21 +15,19 @@ main-is: hedgewars-server.hs Build-depends: - base >= 4, + base >= 4.3, unix, containers, array, bytestring, bytestring-show, - network-bytestring, - network, + network >= 2.3, time, stm, mtl >= 2, dataenc, hslogger, process, - deepseq, - tconfig + deepseq ghc-options: -O2 diff -r 59b13b38a827 -r 7915668502a6 gameServer/stresstest.hs --- a/gameServer/stresstest.hs Tue Mar 29 20:10:56 2011 -0400 +++ b/gameServer/stresstest.hs Sat Apr 02 20:01:20 2011 +0400 @@ -40,7 +40,7 @@ putStrLn "Finish" forks = forever $ do - delay <- randomRIO (30000::Int, 69000) + delay <- randomRIO (0::Int, 90000) threadDelay delay forkIO testing