# HG changeset patch
# User unc0rr
# Date 1235581952 0
# Node ID fba7210b438b49a2985c9eba81e7c83b295cabeb
# Parent  4747f0232b88cfcb032da07950345dd7dbc4d512
Retrieve client password from web database and ask for it

diff -r 4747f0232b88 -r fba7210b438b QTfrontend/newnetclient.cpp
--- a/QTfrontend/newnetclient.cpp	Tue Feb 24 21:47:17 2009 +0000
+++ b/QTfrontend/newnetclient.cpp	Wed Feb 25 17:12:32 2009 +0000
@@ -428,6 +428,11 @@
 		return;
 	}
 
+	if (lst[0] == "ASKPASSWORD") {
+		RawSendNet(QString("PASSWORD"));
+		return;
+	}
+
 	if (lst[0] == "TEAM_ACCEPTED") {
 		if (lst.size() != 2)
 		{
diff -r 4747f0232b88 -r fba7210b438b gameServer/Actions.hs
--- a/gameServer/Actions.hs	Tue Feb 24 21:47:17 2009 +0000
+++ b/gameServer/Actions.hs	Wed Feb 25 17:12:32 2009 +0000
@@ -23,6 +23,7 @@
 	| RemoveTeam String
 	| RemoveRoom
 	| UnreadyRoomClients
+	| MoveToLobby
 	| ProtocolError String
 	| Warning String
 	| ByeClient String
@@ -250,17 +251,33 @@
 	where
 		client = clients ! clID
 
+
 processAction (clID, serverInfo, clients, rooms) (Dump) = do
 	writeChan (sendChan $ clients ! clID) ["DUMP", show serverInfo, showTree clients, showTree rooms]
 	return (clID, serverInfo, clients, rooms)
 
+
 processAction (clID, serverInfo, clients, rooms) (ProcessAccountInfo info) = do
 	case info of
-		HasAccount -> do
+		HasAccount passwd -> do
 			infoM "Clients" $ show clID ++ " has account"
 			writeChan (sendChan $ clients ! clID) ["ASKPASSWORD"]
-		LogonPassed -> do
-			infoM "Clients" $ show clID ++ " authenticated"
+			return (clID, serverInfo, adjust (\cl -> cl{webPassword = passwd}) clID clients, rooms)
 		Guest -> do
 			infoM "Clients" $ show clID ++ " is guest"
-	return (clID, serverInfo, clients, rooms)
+			processAction (clID, serverInfo, adjust (\cl -> cl{logonPassed = True}) clID clients, rooms) MoveToLobby
+
+
+processAction (clID, serverInfo, clients, rooms) (MoveToLobby) = do
+	foldM processAction (clID, serverInfo, clients, rooms) $
+		(RoomAddThisClient 0)
+		: answerLobbyNicks
+		-- ++ (answerServerMessage client clients)
+	where
+		lobbyNicks = Prelude.filter (\n -> (not (Prelude.null n))) $ Prelude.map nick $ elems clients
+		answerLobbyNicks = if not $ Prelude.null lobbyNicks then
+					[AnswerThisClient (["LOBBY:JOINED"] ++ lobbyNicks)]
+				else
+					[]
+
+
diff -r 4747f0232b88 -r fba7210b438b gameServer/CoreTypes.hs
--- a/gameServer/CoreTypes.hs	Tue Feb 24 21:47:17 2009 +0000
+++ b/gameServer/CoreTypes.hs	Wed Feb 25 17:12:32 2009 +0000
@@ -19,6 +19,8 @@
 		clientHandle :: Handle,
 		host :: String,
 		nick :: String,
+		webPassword :: String,
+		logonPassed :: Bool,
 		clientProto :: Word16,
 		roomID :: Int,
 		isMaster :: Bool,
@@ -137,8 +139,7 @@
 	)
 
 data AccountInfo =
-	HasAccount
-	| LogonPassed
+	HasAccount String
 	| Guest
 
 data CoreMessage =
diff -r 4747f0232b88 -r fba7210b438b gameServer/HWProtoCore.hs
--- a/gameServer/HWProtoCore.hs	Tue Feb 24 21:47:17 2009 +0000
+++ b/gameServer/HWProtoCore.hs	Wed Feb 25 17:12:32 2009 +0000
@@ -25,7 +25,7 @@
 		removeClientTeams = map (RemoveTeam . teamname) clientTeams
 
 handleCmd clID clients rooms cmd =
-	if null (nick client) || clientProto client == 0 then
+	if not $ logonPassed client then
 		handleCmd_NotEntered clID clients rooms cmd
 	else if roomID client == 0 then
 		handleCmd_lobby clID clients rooms cmd
diff -r 4747f0232b88 -r fba7210b438b gameServer/HWProtoNEState.hs
--- a/gameServer/HWProtoNEState.hs	Tue Feb 24 21:47:17 2009 +0000
+++ b/gameServer/HWProtoNEState.hs	Wed Feb 25 17:12:32 2009 +0000
@@ -11,23 +11,6 @@
 
 handleCmd_NotEntered :: CmdHandler
 
-onLoginFinished :: Int -> String -> Word16 -> Clients -> [Action]
-onLoginFinished clID clientNick clProto clients =
-	if (null $ clientNick) || (clProto == 0) then
-		[]
-	else
-		(RoomAddThisClient 0)
-		: CheckRegistered
-		: answerLobbyNicks
-		-- ++ (answerServerMessage client clients)
-	where
-		lobbyNicks = filter (\n -> (not (null n))) $ map nick $ IntMap.elems clients
-		answerLobbyNicks = if not $ null lobbyNicks then
-					[AnswerThisClient (["LOBBY:JOINED"] ++ lobbyNicks)]
-				else
-					[]
-
-
 handleCmd_NotEntered clID clients _ ["NICK", newNick] =
 	if not . null $ nick client then
 		[ProtocolError "Nick already chosen"]
@@ -37,10 +20,11 @@
 	else
 		[ModifyClient (\c -> c{nick = newNick}),
 		AnswerThisClient ["NICK", newNick]]
-		++ (onLoginFinished clID newNick (clientProto client) clients)
+		++ checkPassword
 	where
 		client = clients IntMap.! clID
 		haveSameNick = isJust $ find (\cl -> newNick == nick cl) $ IntMap.elems clients
+		checkPassword = if clientProto client /= 0 then [CheckRegistered] else []
 
 
 handleCmd_NotEntered clID clients _ ["PROTO", protoNum] =
@@ -51,10 +35,15 @@
 	else
 		[ModifyClient (\c -> c{clientProto = parsedProto}),
 		AnswerThisClient ["PROTO", show parsedProto]]
-		++ (onLoginFinished clID (nick client) parsedProto clients)
+		++ checkPassword
 	where
 		client = clients IntMap.! clID
 		parsedProto = fromMaybe 0 (maybeRead protoNum :: Maybe Word16)
+		checkPassword = if (not . null) (nick client) then [CheckRegistered] else []
+
+handleCmd_NotEntered clID clients _ ["PASSWORD"] =
+	[ModifyClient (\cl -> cl{logonPassed = True}),
+	MoveToLobby]
 
 
 handleCmd_NotEntered _ _ _ ["DUMP"] =
diff -r 4747f0232b88 -r fba7210b438b gameServer/NetRoutines.hs
--- a/gameServer/NetRoutines.hs	Tue Feb 24 21:47:17 2009 +0000
+++ b/gameServer/NetRoutines.hs	Wed Feb 25 17:12:32 2009 +0000
@@ -41,6 +41,8 @@
 					clientHost
 					--currentTime
 					""
+					""
+					False
 					0
 					0
 					False
diff -r 4747f0232b88 -r fba7210b438b gameServer/OfficialServer/DBInteraction.hs
--- a/gameServer/OfficialServer/DBInteraction.hs	Tue Feb 24 21:47:17 2009 +0000
+++ b/gameServer/OfficialServer/DBInteraction.hs	Wed Feb 25 17:12:32 2009 +0000
@@ -29,12 +29,12 @@
 	q <- readChan queries
 	case q of
 		CheckAccount clID name -> do
-				statement <- prepare dbConn "SELECT uid FROM users WHERE name=?"
+				statement <- prepare dbConn "SELECT pass FROM users WHERE name=?"
 				execute statement [SqlString name]
-				uid <- fetchRow statement
+				pass <- fetchRow statement
 				finish statement
-				if isJust uid then
-					writeChan coreChan $ ClientAccountInfo clID HasAccount
+				if isJust pass then
+					writeChan coreChan $ ClientAccountInfo clID (HasAccount $ fromSql $ head $ fromJust $ pass)
 					else
 					writeChan coreChan $ ClientAccountInfo clID Guest
 			`onException`
diff -r 4747f0232b88 -r fba7210b438b gameServer/ServerCore.hs
--- a/gameServer/ServerCore.hs	Tue Feb 24 21:47:17 2009 +0000
+++ b/gameServer/ServerCore.hs	Wed Feb 25 17:12:32 2009 +0000
@@ -19,10 +19,8 @@
 firstAway (_, a, b, c) = (a, b, c)
 
 reactCmd :: ServerInfo -> Int -> [String] -> Clients -> Rooms -> IO (ServerInfo, Clients, Rooms)
-reactCmd serverInfo clID cmd clients rooms = do
-	(_ , serverInfo, clients, rooms) <-
-		foldM processAction (clID, serverInfo, clients, rooms) $ handleCmd clID clients rooms cmd
-	return (serverInfo, clients, rooms)
+reactCmd serverInfo clID cmd clients rooms =
+	liftM firstAway $ foldM processAction (clID, serverInfo, clients, rooms) $ handleCmd clID clients rooms cmd
 
 mainLoop :: ServerInfo -> Clients -> Rooms -> IO ()
 mainLoop serverInfo clients rooms = do
@@ -33,10 +31,9 @@
 			Accept ci -> do
 				let updatedClients = IntMap.insert (clientUID ci) ci clients
 				infoM "Clients" ("New client: id " ++ (show $ clientUID ci))
-				processAction
+				liftM firstAway $ processAction
 					(clientUID ci, serverInfo, updatedClients, rooms)
 					(AnswerThisClient ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"])
-				return (serverInfo, updatedClients, rooms)
 
 			ClientMessage (clID, cmd) -> do
 				debugM "Clients" $ (show clID) ++ ": " ++ (show cmd)