- Some improvements in core
authorunc0rr
Wed, 30 Apr 2008 20:48:12 +0000
changeset 893 149244d86bf1
parent 892 dfe97199f17e
child 894 2ca76a7f3121
- Some improvements in core - Handle 'NICK' command
netserver/HWProto.hs
netserver/newhwserv.hs
--- 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