Another approach for fixing listener thread issues, should finally get rid of all problems. Not tested. server_refactor
authorunc0rr
Tue, 25 Jan 2011 22:13:34 +0300
branchserver_refactor
changeset 4585 6e747aef012f
parent 4583 ab82045ea083
child 4587 adf64662b6a8
Another approach for fixing listener thread issues, should finally get rid of all problems. Not tested.
gameServer/Actions.hs
gameServer/ClientIO.hs
--- 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])