# HG changeset patch
# User unc0rr
# Date 1294675064 -10800
# Node ID 4e61c2a42121fc646a04c495f131a73b82578c06
# Parent  2c43cd7d5ce65a7bc4436cc739dae4c455f0b12c
Explicitly kill listening thread in try to prevent messages recieving bugs

diff -r 2c43cd7d5ce6 -r 4e61c2a42121 gameServer/Actions.hs
--- a/gameServer/Actions.hs	Mon Jan 10 18:29:43 2011 +0300
+++ b/gameServer/Actions.hs	Mon Jan 10 18:57:44 2011 +0300
@@ -427,8 +427,8 @@
     si <- gets serverInfo
     liftIO $ do
         ci <- addClient rnc client
-        forkIO $ clientRecvLoop (clientSocket client) (coreChan si) ci
-        forkIO $ clientSendLoop (clientSocket client) (sendChan client) ci
+        t <- forkIO $ clientRecvLoop (clientSocket client) (coreChan si) ci
+        forkIO $ clientSendLoop (clientSocket client) t (sendChan client) ci
 
         infoM "Clients" (show ci ++ ": New client. Time: " ++ show (connectTime client))
 
diff -r 2c43cd7d5ce6 -r 4e61c2a42121 gameServer/ClientIO.hs
--- a/gameServer/ClientIO.hs	Mon Jan 10 18:29:43 2011 +0300
+++ b/gameServer/ClientIO.hs	Mon Jan 10 18:57:44 2011 +0300
@@ -57,17 +57,19 @@
 
 
 
-clientSendLoop :: Socket -> Chan [B.ByteString] -> ClientIndex -> IO ()
-clientSendLoop s 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) -> when (not $ isQuit answer) $ sendQuit e) $ do
             sendAll s $ (B.unlines answer) `B.append` (B.singleton '\n')
 
     if (isQuit answer) then
+        do
+        killThread tId
         Exception.handle (\(_ :: Exception.IOException) -> putStrLn "error on sClose") $ sClose s
         else
-        clientSendLoop s chan ci
+        clientSendLoop s tId chan ci
 
     where
         --sendQuit e = writeChan coreChan $ ClientMessage (ci, ["QUIT", B.pack $ show e])
diff -r 2c43cd7d5ce6 -r 4e61c2a42121 gameServer/CoreTypes.hs
--- a/gameServer/CoreTypes.hs	Mon Jan 10 18:29:43 2011 +0300
+++ b/gameServer/CoreTypes.hs	Mon Jan 10 18:57:44 2011 +0300
@@ -2,6 +2,7 @@
 module CoreTypes where
 
 import System.IO
+import Control.Concurrent
 import Control.Concurrent.Chan
 import Control.Concurrent.STM
 import Data.Word
diff -r 2c43cd7d5ce6 -r 4e61c2a42121 gameServer/HWProtoNEState.hs
--- a/gameServer/HWProtoNEState.hs	Mon Jan 10 18:29:43 2011 +0300
+++ b/gameServer/HWProtoNEState.hs	Mon Jan 10 18:57:44 2011 +0300
@@ -20,7 +20,7 @@
     let cl = irnc `client` ci
     if not . B.null $ nick cl then return [ProtocolError "Nickname already chosen"]
         else
-        if haveSameNick irnc then return [AnswerClients [sendChan cl] ["WARNING", "Nickname already in use"], ByeClient ""]
+        if haveSameNick irnc then return [{-AnswerClients [sendChan cl] ["WARNING", "Nickname already in use"], -}ByeClient "Nickname already in use"]
             else
             if illegalName newNick then return [ByeClient "Illegal nickname"]
                 else