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