# HG changeset patch
# User unc0rr
# Date 1209584694 0
# Node ID 1d8c4a5ec622097504707127149de447c82839cf
# Parent  3bf9dc791f45131f06dc1e23e5f64b4cc67f6441
 - Improve server core
 - Protocol in separate module

diff -r 3bf9dc791f45 -r 1d8c4a5ec622 netserver/HWProto.hs
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/netserver/HWProto.hs	Wed Apr 30 19:44:54 2008 +0000
@@ -0,0 +1,7 @@
+module HWProto where
+
+import IO
+import Miscutils
+
+handleCmd :: ClientInfo -> [ClientInfo] -> [RoomInfo] -> String -> (Bool, Bool, [String])
+handleCmd _ _ _ ('Q':'U':'I':'T':xs) = (True, False, [])
diff -r 3bf9dc791f45 -r 1d8c4a5ec622 netserver/Miscutils.hs
--- a/netserver/Miscutils.hs	Wed Apr 30 16:50:28 2008 +0000
+++ b/netserver/Miscutils.hs	Wed Apr 30 19:44:54 2008 +0000
@@ -53,6 +53,6 @@
 			writeTVar state2 ol2
 			return res
 
-tselect :: [ClientInfo] -> STM (String, Handle)
-tselect = foldl orElse retry . map (\ci -> (flip (,) (handle ci)) `fmap` readTChan (chan ci))
+tselect :: [ClientInfo] -> STM (String, ClientInfo)
+tselect = foldl orElse retry . map (\ci -> (flip (,) ci) `fmap` readTChan (chan ci))
 
diff -r 3bf9dc791f45 -r 1d8c4a5ec622 netserver/newhwserv.hs
--- a/netserver/newhwserv.hs	Wed Apr 30 16:50:28 2008 +0000
+++ b/netserver/newhwserv.hs	Wed Apr 30 19:44:54 2008 +0000
@@ -6,8 +6,10 @@
 import Control.Concurrent
 import Control.Concurrent.STM
 import Control.Exception (finally)
-import Control.Monad (forM, filterM, liftM)
+import Control.Monad (forM, forM_, filterM, liftM)
+import Data.List
 import Miscutils
+import HWProto
 
 acceptLoop :: Socket -> TChan ClientInfo -> IO ()
 acceptLoop servSock acceptChan = do
@@ -36,15 +38,21 @@
 	case r of
 		Left ci -> do
 			mainLoop servSock acceptChan (ci:clients) rooms
-		Right (line, clhandle) -> do
-			--handleCmd handle line
-			clients' <- forM clients $
+		Right (line, client) -> do
+			let (doQuit, toMe, strs) = handleCmd client sameRoom rooms line
+
+			clients' <- forM sameRoom $
 					\ci -> do
-						hPutStrLn (handle ci) line
-						hFlush (handle ci)
-						return [ci]
-					`catch` const (hClose (handle ci) >> return [])
-			mainLoop servSock acceptChan (concat clients') rooms
+						if (handle ci /= handle client) || toMe then do
+							forM_ strs (\str -> hPutStrLn (handle ci) str)
+							hFlush (handle ci)
+							return []
+							else if doQuit then return [ci] else return []
+					`catch` const (hClose (handle ci) >> return [ci])
+
+			mainLoop servSock acceptChan (deleteFirstsBy (\ a b -> handle a == handle b) clients (concat clients')) rooms
+			where
+				sameRoom = filter (\cl -> room cl == room client) clients
 
 startServer serverSocket = do
 	acceptChan <- atomically newTChan