--- a/netserver/HWProto.hs Wed Apr 30 20:18:30 2008 +0000
+++ b/netserver/HWProto.hs Wed Apr 30 20:48:12 2008 +0000
@@ -3,12 +3,25 @@
import IO
import Miscutils
-handleCmd :: ClientInfo -> [ClientInfo] -> [RoomInfo] -> [String] -> ([ClientInfo], [String])
+handleCmd :: ClientInfo -> [ClientInfo] -> [RoomInfo] -> [String] -> (ClientInfo, [RoomInfo], [ClientInfo], [String])
-handleCmd client clients _ ("QUIT":xs) =
+
+handleCmd client clients rooms ("QUIT":xs) =
if null (room client) then
- ([client], ["QUIT"])
+ (client, rooms, [client], ["QUIT"])
else
- (clients, ["QUIT", nick client])
+ (client, rooms, clients, ["QUIT", nick client])
+
-handleCmd client _ _ _ = ([client], ["Bad command"])
+handleCmd client clients rooms ("NICK":newNick:[]) =
+ if not . null $ nick client then
+ (client, rooms, [client], ["ERROR", "The nick already chosen"])
+ else if haveSameNick then
+ (client, rooms, [client], ["ERROR", "Choose another nick"])
+ else
+ (client{nick = newNick}, rooms, [client], ["NICK", newNick])
+ where
+ haveSameNick = not . null $ filter (\cl -> newNick == nick cl) clients
+
+
+handleCmd client _ rooms _ = (client, rooms, [client], ["ERROR", "Bad command"])
--- a/netserver/newhwserv.hs Wed Apr 30 20:18:30 2008 +0000
+++ b/netserver/newhwserv.hs Wed Apr 30 20:48:12 2008 +0000
@@ -39,7 +39,7 @@
Left ci -> do
mainLoop servSock acceptChan (ci:clients) rooms
Right (line, client) -> do
- let (recipients, strs) = handleCmd client sameRoom rooms $ words line
+ let (mclient, mrooms, recipients, strs) = handleCmd client clients rooms $ words line
clients' <- forM recipients $
\ci -> do
@@ -50,9 +50,8 @@
client' <- if head strs == "QUIT" then hClose (handle client) >> return [client] else return []
- mainLoop servSock acceptChan (remove (remove clients (concat clients')) client') rooms
+ mainLoop servSock acceptChan (remove (remove (mclient : filter (\cl -> handle cl /= handle client) clients) (concat clients')) client') mrooms
where
- sameRoom = filter (\cl -> room cl == room client) clients
remove list rmClients = deleteFirstsBy (\ a b -> handle a == handle b) list rmClients
startServer serverSocket = do