Another approach for fixing listener thread issues, should finally get rid of all problems. Not tested.
--- a/gameServer/Actions.hs Mon Jan 24 21:33:03 2011 +0300
+++ b/gameServer/Actions.hs Tue Jan 25 22:13:34 2011 +0300
@@ -428,7 +428,7 @@
liftIO $ do
ci <- addClient rnc client
t <- forkIO $ clientRecvLoop (clientSocket client) (coreChan si) ci
- forkIO $ clientSendLoop (clientSocket client) t (sendChan client) ci
+ forkIO $ clientSendLoop (clientSocket client) t (coreChan si) (sendChan client) ci
infoM "Clients" (show ci ++ ": New client. Time: " ++ show (connectTime client))
--- a/gameServer/ClientIO.hs Mon Jan 24 21:33:03 2011 +0300
+++ b/gameServer/ClientIO.hs Tue Jan 25 22:13:34 2011 +0300
@@ -52,13 +52,13 @@
clientRecvLoop s chan ci = do
msg <- (listenLoop s chan ci >> return "Connection closed") `catch` (return . B.pack . show)
clientOff msg
- where
- clientOff msg = mapM_ (writeChan chan) [ClientMessage (ci, ["QUIT", msg]), Remove ci]
+ where
+ clientOff msg = writeChan chan $ ClientMessage (ci, ["QUIT", msg])
-clientSendLoop :: Socket -> ThreadId -> Chan [B.ByteString] -> ClientIndex -> IO ()
-clientSendLoop s tId chan ci = do
+clientSendLoop :: Socket -> ThreadId -> Chan CoreMessage -> Chan [B.ByteString] -> ClientIndex -> IO ()
+clientSendLoop s tId coreChan chan ci = do
answer <- readChan chan
Exception.handle
(\(e :: Exception.IOException) -> when (not $ isQuit answer) $ sendQuit e) $ do
@@ -66,10 +66,11 @@
if (isQuit answer) then
do
+ Exception.handle (\(_ :: Exception.IOException) -> putStrLn "error on sClose") $ sClose s
killThread tId
- Exception.handle (\(_ :: Exception.IOException) -> putStrLn "error on sClose") $ sClose s
+ writeChan coreChan $ Remove ci
else
- clientSendLoop s tId chan ci
+ clientSendLoop s tId coreChan chan ci
where
--sendQuit e = writeChan coreChan $ ClientMessage (ci, ["QUIT", B.pack $ show e])