# HG changeset patch
# User unc0rr
# Date 1208541977 0
# Node ID 82ac0596aa3c7712c7519da147d68a6b5ba31819
# Parent  b31b72756927b30745636931691e4dfe621dff4b
Start work on standalone server in Haskell

diff -r b31b72756927 -r 82ac0596aa3c netserver/Miscutils.hs
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/netserver/Miscutils.hs	Fri Apr 18 18:06:17 2008 +0000
@@ -0,0 +1,27 @@
+module Miscutils where
+
+import IO
+import System.IO
+import Control.Concurrent
+import Control.Concurrent.STM
+import Control.Exception (finally)
+
+sendMsg :: Handle -> String -> IO()
+sendMsg clientHandle str = finally (return ()) (hPutStrLn clientHandle str >> hFlush clientHandle) -- catch exception when client tries to send to other
+
+sendAll :: [Handle] -> String -> IO[()]
+sendAll clientsList str = mapM (\x -> sendMsg x str) clientsList
+
+sendOthers :: [Handle] -> Handle -> String -> IO[()]
+sendOthers clientsList clientHandle str = sendAll (filter (/= clientHandle) clientsList) str
+
+extractCmd :: String -> (String, [String])
+extractCmd str = if ws == [] then ("", []) else (head ws, tail ws)
+		where ws = words str
+
+manipState :: TVar[a] -> ([a] -> [a]) -> IO()
+manipState state op =
+	atomically $ do
+			ls <- readTVar state
+			writeTVar state $ op ls
+
diff -r b31b72756927 -r 82ac0596aa3c netserver/hwserv.hs
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/netserver/hwserv.hs	Fri Apr 18 18:06:17 2008 +0000
@@ -0,0 +1,74 @@
+module Main where
+
+import Network
+import IO
+import System.IO
+import Control.Concurrent
+import Control.Concurrent.STM
+import Control.Exception (finally)
+import Miscutils
+
+data ClientInfo =
+	ClientInfo
+	{
+		handle :: Handle,
+		nick :: String,
+		game :: String,
+		isMaster :: Bool
+	}
+
+data RoomInfo =
+	RoomInfo
+	{
+		name :: String,
+		password :: String
+	}
+
+
+handleCmd :: Handle -> TVar[ClientInfo] -> TVar[RoomInfo] -> (String, [String]) -> IO()
+handleCmd clientHandle clientsList roomsList ("SAY", param) = do
+		ls <- atomically(readTVar clientsList)
+		sendOthers (map (\x -> handle x) ls) clientHandle (concat param)
+		return ()
+
+handleCmd clientHandle clientsList roomsList ("CREATE", [roomname]) = do
+		manipState roomsList (\x -> (RoomInfo roomname ""):x)
+		manipState clientsList (\x -> map (\xc -> if (clientHandle == handle xc) then xc{isMaster = True, game = roomname} else xc) x)
+		sendMsg clientHandle ("JOINED " ++ roomname)
+
+handleCmd clientHandle clientsList roomsList ("LIST", []) = do
+		rl <- atomically $ readTVar roomsList
+		sendMsg clientHandle (unlines $ map (\x -> name x) rl)
+
+handleCmd clientHandle _ _ ("PING", _) = sendMsg clientHandle "PONG"
+
+handleCmd clientHandle _ _ (_, _) = sendMsg clientHandle "Unknown cmd or bad syntax"
+
+
+clientLoop :: Handle -> TVar[ClientInfo] -> TVar[RoomInfo] -> IO()
+clientLoop clientHandle clientsList roomsList = do
+		cline <- hGetLine clientHandle
+		let (cmd, params) = extractCmd cline
+		handleCmd clientHandle clientsList roomsList (cmd, params)
+		if cmd /= "QUIT" then clientLoop clientHandle clientsList roomsList else return ()
+
+
+main = do
+	clientsList <- atomically $ newTVar[]
+	roomsList <- atomically $ newTVar[]
+	bracket
+		(listenOn $ PortNumber 46631)
+		(sClose)
+		(loop clientsList roomsList)
+		where
+			loop clist rlist sock = accept sock >>= addClient clist rlist >> loop clist rlist sock
+
+			addClient clist rlist (chandle, hostname, port) = do
+				putStrLn $ "Client connected: " ++ show hostname
+				hSetBuffering chandle LineBuffering
+				manipState clist (\x -> (ClientInfo chandle "" "" False):x) -- add client to list
+				forkIO $ finally
+					(clientLoop chandle clist rlist)
+					(do
+					manipState clist (\x -> filter (\x -> chandle /= handle x) x) -- remove client from list
+					hClose chandle)