# HG changeset patch # User unc0rr # Date 1209654872 0 # Node ID 6aee2f335726006514a84895261542b5c232038b # Parent 2ca76a7f31216f6d76f21e055b7ff0f0a1d640c4 - Remove old hwserv code - Introduce rooms (CREATE and JOIN commands handling) diff -r 2ca76a7f3121 -r 6aee2f335726 netserver/HWProto.hs --- a/netserver/HWProto.hs Thu May 01 14:30:12 2008 +0000 +++ b/netserver/HWProto.hs Thu May 01 15:14:32 2008 +0000 @@ -5,11 +5,12 @@ import Miscutils import Maybe (fromMaybe) -handleCmd :: ClientInfo -> [ClientInfo] -> [RoomInfo] -> [String] -> (ClientInfo, [RoomInfo], [ClientInfo], [String]) -handleCmd_noInfo :: ClientInfo -> [ClientInfo] -> [RoomInfo] -> [String] -> (ClientInfo, [RoomInfo], [ClientInfo], [String]) -handleCmd_noRoom :: ClientInfo -> [ClientInfo] -> [RoomInfo] -> [String] -> (ClientInfo, [RoomInfo], [ClientInfo], [String]) +fromRoom :: String -> [ClientInfo] -> [ClientInfo] +fromRoom roomName clients = filter (\cl -> roomName == room cl) clients -- 'noInfo' clients state command handlers +handleCmd_noInfo :: ClientInfo -> [ClientInfo] -> [RoomInfo] -> [String] -> (ClientInfo, [RoomInfo], [ClientInfo], [String]) + handleCmd_noInfo client clients rooms ("NICK":newNick:[]) = if not . null $ nick client then (client, rooms, [client], ["ERROR", "The nick already chosen"]) @@ -35,18 +36,42 @@ -- 'noRoom' clients state command handlers ---handleCmd_noRoom client clients rooms ("CREATE":newRoom:[]) = +handleCmd_noRoom :: ClientInfo -> [ClientInfo] -> [RoomInfo] -> [String] -> (ClientInfo, [RoomInfo], [ClientInfo], [String]) + +handleCmd_noRoom client clients rooms ("CREATE":newRoom:roomPassword:[]) = + if haveSameRoom then + (client, rooms, [client], ["WARNING", "There's already a room with that name"]) + else + (client{room = newRoom, isMaster = True}, (RoomInfo newRoom roomPassword):rooms, [client], ["JOIN", newRoom, nick client]) + where + haveSameRoom = not . null $ filter (\room -> newRoom == name room) rooms + +handleCmd_noRoom client clients rooms ("CREATE":newRoom:[]) = + handleCmd_noRoom client clients rooms ["CREATE", newRoom, ""] + +handleCmd_noRoom client clients rooms ("JOIN":roomName:roomPassword:[]) = + if noRoom then + (client, rooms, [client], ["WARNING", "There's no room with that name"]) + else + (client{room = roomName}, rooms, client : fromRoom roomName clients, ["JOIN", roomName, nick client]) + where + noRoom = null $ filter (\room -> roomName == name room) rooms + +handleCmd_noRoom client clients rooms ("JOIN":roomName:[]) = + handleCmd_noRoom client clients rooms ["JOIN", roomName, ""] handleCmd_noRoom client _ rooms _ = (client, rooms, [client], ["ERROR", "Bad command or incorrect parameter"]) - + +-- state-independent comman handlers +handleCmd :: ClientInfo -> [ClientInfo] -> [RoomInfo] -> [String] -> (ClientInfo, [RoomInfo], [ClientInfo], [String]) handleCmd client clients rooms ("QUIT":xs) = if null (room client) then (client, rooms, [client], ["QUIT"]) else - (client, rooms, clients, ["QUIT", nick client]) + (client, rooms, fromRoom (room client) clients, ["QUIT", nick client]) - +-- check state and call state-dependent commmand handlers handleCmd client clients rooms cmd = if null (nick client) || protocol client == 0 then handleCmd_noInfo client clients rooms cmd diff -r 2ca76a7f3121 -r 6aee2f335726 netserver/Miscutils.hs --- a/netserver/Miscutils.hs Thu May 01 14:30:12 2008 +0000 +++ b/netserver/Miscutils.hs Thu May 01 15:14:32 2008 +0000 @@ -26,36 +26,6 @@ password :: String } - -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 - -manipState2 :: TVar[ClientInfo] -> TVar[RoomInfo] -> ([ClientInfo] -> [RoomInfo] -> ([ClientInfo], [RoomInfo], Bool)) -> IO Bool -manipState2 state1 state2 op = - atomically $ do - ls1 <- readTVar state1 - ls2 <- readTVar state2 - let (ol1, ol2, res) = op ls1 ls2 - writeTVar state1 ol1 - writeTVar state2 ol2 - return res - tselect :: [ClientInfo] -> STM (String, ClientInfo) tselect = foldl orElse retry . map (\ci -> (flip (,) ci) `fmap` readTChan (chan ci)) @@ -63,4 +33,3 @@ maybeRead s = case reads s of [(x, rest)] | all isSpace rest -> Just x _ -> Nothing - diff -r 2ca76a7f3121 -r 6aee2f335726 netserver/hwserv.hs --- a/netserver/hwserv.hs Thu May 01 14:30:12 2008 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,69 +0,0 @@ -module Main where - -import Network -import IO -import System.IO -import Control.Concurrent -import Control.Concurrent.STM -import Control.Exception (finally) -import Miscutils - - -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 - res <- manipState2 clientsList roomsList (hcCreate) - if res then sendMsg clientHandle ("JOINED " ++ roomname) else sendMsg clientHandle "Already exists" - where - hcCreate ci ri = if (null $ filter (\ xr -> roomname == name xr) ri) then - (map - (\ xc - -> if (clientHandle == handle xc) then - xc {isMaster = True, room = roomname} - else - xc) - ci, - (RoomInfo roomname "") : ri, True) - else - (ci, ri, False) - -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 $ Service "hedgewars") - (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)