--- 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))
--- 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
--- 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
--- 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