# HG changeset patch # User koda # Date 1301763346 -7200 # Node ID a71bf5a786d1cd4d502bf82baf977a944b424124 # Parent 85318bb2983e3c9668b9c459f27c3365055143cd# Parent 2d2422772832a68a713b24e5d7133550bed55d5b merge -- this time i tested diff -r 2d2422772832 -r a71bf5a786d1 gameServer/Actions.hs --- a/gameServer/Actions.hs Sat Apr 02 12:52:19 2011 -0400 +++ b/gameServer/Actions.hs Sat Apr 02 18:55:46 2011 +0200 @@ -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 2d2422772832 -r a71bf5a786d1 gameServer/ClientIO.hs --- a/gameServer/ClientIO.hs Sat Apr 02 12:52:19 2011 -0400 +++ b/gameServer/ClientIO.hs Sat Apr 02 18:55:46 2011 +0200 @@ -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 2d2422772832 -r a71bf5a786d1 gameServer/hedgewars-server.cabal --- a/gameServer/hedgewars-server.cabal Sat Apr 02 12:52:19 2011 -0400 +++ b/gameServer/hedgewars-server.cabal Sat Apr 02 18:55:46 2011 +0200 @@ -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 2d2422772832 -r a71bf5a786d1 gameServer/stresstest.hs --- a/gameServer/stresstest.hs Sat Apr 02 12:52:19 2011 -0400 +++ b/gameServer/stresstest.hs Sat Apr 02 18:55:46 2011 +0200 @@ -40,7 +40,7 @@ putStrLn "Finish" forks = forever $ do - delay <- randomRIO (30000::Int, 69000) + delay <- randomRIO (0::Int, 90000) threadDelay delay forkIO testing