--- 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)
{
--- 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
+ []
+
+
--- 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 =
--- 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
--- 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"] =
--- 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
--- 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`
--- 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)