Mercurial Mercurial > sheepy-clone / changeset
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
- Improve server core
authorunc0rr
Wed, 30 Apr 2008 19:44:54 +0000
changeset 890 1d8c4a5ec622
parent 889 3bf9dc791f45
child 891 701f86df9b4c
- Improve server core - Protocol in separate module
netserver/HWProto.hs file | annotate | diff | comparison | revisions
netserver/Miscutils.hs file | annotate | diff | comparison | revisions
netserver/newhwserv.hs file | annotate | diff | comparison | revisions 
--- /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, [])
--- 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))
 
--- 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
sheepy-clone