Some fixes. Can't reproduce ghosts now.
authorunc0rr
Sat, 02 Apr 2011 20:01:20 +0400
changeset 5077 7915668502a6
parent 5075 59b13b38a827
child 5079 ced35a120f7c
Some fixes. Can't reproduce ghosts now.
gameServer/Actions.hs
gameServer/ClientIO.hs
gameServer/hedgewars-server.cabal
gameServer/stresstest.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))
 
--- 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
--- 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
--- 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