--- a/gameServer/Actions.hs	Mon Mar 28 20:28:59 2011 +0400
+++ b/gameServer/Actions.hs	Mon Mar 28 20:30:15 2011 +0400
@@ -5,6 +5,7 @@
 import qualified Data.Set as Set
 import qualified Data.Sequence as Seq
 import qualified Data.List as L
+import qualified Control.Exception as Exception
 import System.Log.Logger
 import Control.Monad
 import Data.Time
@@ -394,8 +395,7 @@
     si <- gets serverInfo
     newClId <- io $ do
         ci <- addClient rnc cl
-        t <- forkIO $ clientRecvLoop (clientSocket cl) (coreChan si) ci
-        _ <- forkIO $ clientSendLoop (clientSocket cl) t (coreChan si) (sendChan cl) ci
+        _ <- Exception.block . forkIO $ clientRecvLoop (clientSocket cl) (coreChan si) (sendChan cl) ci
 
         infoM "Clients" (show ci ++ ": New client. Time: " ++ show (connectTime cl))
 
@@ -406,7 +406,7 @@
         [
             AnswerClients [sendChan cl] ["CONNECTED", "Hedgewars server http://www.hedgewars.org/", serverVersion]
             , CheckBanned
-            , AddIP2Bans (host cl) "Reconnected too fast" (addUTCTime 10 $ connectTime cl)
+--            , AddIP2Bans (host cl) "Reconnected too fast" (addUTCTime 10 $ connectTime cl)
         ]
 
 

--- a/gameServer/ClientIO.hs	Mon Mar 28 20:28:59 2011 +0400
+++ b/gameServer/ClientIO.hs	Mon Mar 28 20:30:15 2011 +0400
@@ -5,19 +5,18 @@
 import Control.Monad.State
 import Control.Concurrent.Chan
 import Control.Concurrent
-import Control.Monad
 import Network
 import Network.Socket.ByteString
 import qualified Data.ByteString.Char8 as B
 ----------------
 import CoreTypes
 import RoomsAndClients
-import Utils
 
 
 pDelim :: B.ByteString
 pDelim = "\n\n"
 
+bs2Packets :: B.ByteString -> ([[B.ByteString]], B.ByteString)
 bs2Packets = runState takePacks
 
 takePacks :: State B.ByteString [[B.ByteString]]
@@ -31,7 +30,7 @@
             return (B.splitWith (== '\n') packet : packets)
 
 listenLoop :: Socket -> Chan CoreMessage -> ClientIndex -> IO ()
-listenLoop sock chan ci = recieveWithBufferLoop B.empty
+listenLoop sock chan ci = Exception.unblock $ recieveWithBufferLoop B.empty
     where
         recieveWithBufferLoop recvBuf = do
             recvBS <- recv sock 4096
@@ -42,11 +41,13 @@
 
         sendPacket packet = writeChan chan $ ClientMessage (ci, packet)
 
-clientRecvLoop :: Socket -> Chan CoreMessage -> ClientIndex -> IO ()
-clientRecvLoop s chan ci =
-        (listenLoop s chan ci >> return "Connection closed")
+clientRecvLoop :: Socket -> Chan CoreMessage -> Chan [B.ByteString] -> ClientIndex -> IO ()
+clientRecvLoop s chan clChan ci =
+    myThreadId >>=
+    \t -> 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)
-        `Exception.catch` (\(e :: Exception.IOException) -> return . B.pack . show $ e)
         >>= clientOff >> remove
     where
         clientOff msg = writeChan chan $ ClientMessage (ci, ["QUIT", msg])
@@ -54,8 +55,8 @@
 
 
 
-clientSendLoop :: Socket -> ThreadId -> Chan CoreMessage -> Chan [B.ByteString] -> ClientIndex -> IO ()
-clientSendLoop s tId cChan chan ci = do
+clientSendLoop :: Socket -> ThreadId -> Chan [B.ByteString] -> ClientIndex -> IO ()
+clientSendLoop s tId chan ci = do
     answer <- readChan chan
     Exception.handle
         (\(e :: Exception.IOException) -> unless (isQuit answer) . killReciever $ show e) $
@@ -66,7 +67,7 @@
         Exception.handle (\(_ :: Exception.IOException) -> putStrLn "error on sClose") $ sClose s
         killReciever . B.unpack $ quitMessage answer
         else
-        clientSendLoop s tId cChan chan ci
+        clientSendLoop s tId chan ci
 
     where
         killReciever = Exception.throwTo tId . ShutdownThreadException