# HG changeset patch
# User unc0rr
# Date 1223249771 0
# Node ID e848447f29be63292557986d4f66dc6f708af7ee
# Parent  453882eb4467143f55fa21af9c967b65835a531e
Fix server crash on client disconnect

diff -r 453882eb4467 -r e848447f29be netserver/newhwserv.hs
--- a/netserver/newhwserv.hs	Sun Oct 05 23:27:53 2008 +0000
+++ b/netserver/newhwserv.hs	Sun Oct 05 23:36:11 2008 +0000
@@ -35,6 +35,27 @@
 		`catch` (const $ clientOff >> return ())
 	where clientOff = atomically $ writeTChan chan ["QUIT"] -- если клиент отключается, то делаем вид, что от него пришла команда QUIT
 
+sendAnswers [] _ clients _ = return clients
+sendAnswers ((handlesFunc, answer):answers) client clients rooms = do
+	putStrLn ("< " ++ show answer)
+	
+	let recipients = handlesFunc client clients rooms
+
+	clHandles' <- forM recipients $
+		\ch -> do
+			forM_ answer (\str -> hPutStrLn ch str)
+			hPutStrLn ch ""
+			hFlush ch
+			if (not $ null answer) && (head answer == "BYE") then hClose ch >> return [ch] else return []
+		`catch` const (hClose ch >> return [ch])
+
+	let mclients = remove clients $ concat clHandles'
+
+	sendAnswers answers client mclients rooms
+	where
+		remove list rmClHandles = deleteFirstsBy2t (\ a b -> (handle a) == b) list rmClHandles
+
+
 mainLoop :: Socket -> TChan ClientInfo -> [ClientInfo] -> [RoomInfo] -> IO ()
 mainLoop servSock acceptChan clients rooms = do
 	r <- atomically $ (Left `fmap` readTChan acceptChan) `orElse` (Right `fmap` tselect clients)
@@ -48,21 +69,9 @@
 			let mclients = clientsFunc clients
 			let mrooms = roomsFunc rooms
 
-			clHandles' <- forM answers $
-				\(handlesFunc, answer) -> do
-					putStrLn ("< " ++ show answer)
-					let recipients = handlesFunc client mclients mrooms
-					forM recipients $
-						\ch -> do
-							forM_ answer (\str -> hPutStrLn ch str)
-							hPutStrLn ch ""
-							hFlush ch
-							if (not $ null answer) && (head answer == "BYE") then hClose ch >> return [ch] else return []
-						`catch` const (hClose ch >> return [ch])
-
-			mainLoop servSock acceptChan (remove mclients (concat $ concat clHandles')) mrooms
-			where
-				remove list rmClHandles = deleteFirstsBy2t (\ a b -> (handle a) == b) list rmClHandles
+			mclients <- sendAnswers answers client clients rooms
+			
+			mainLoop servSock acceptChan mclients mrooms
 
 startServer serverSocket = do
 	acceptChan <- atomically newTChan