Logon procedure for checkers, introduce invisible clients
authorunc0rr
Sun, 13 Jan 2013 01:02:08 +0400
changeset 8372 3c193ec03e09
parent 8371 0551b5c3de9a
child 8373 209c9ba77a09
child 8374 3a1708759c4f
Logon procedure for checkers, introduce invisible clients
gameServer/Actions.hs
gameServer/CoreTypes.hs
gameServer/HWProtoNEState.hs
gameServer/NetRoutines.hs
--- a/gameServer/Actions.hs	Sat Jan 12 01:18:50 2013 +0400
+++ b/gameServer/Actions.hs	Sun Jan 13 01:02:08 2013 +0400
@@ -142,13 +142,13 @@
 
     chan <- client's sendChan
     clNick <- client's nick
-    loggedIn <- client's logonPassed
+    loggedIn <- client's isVisible
 
     when (ri /= lobbyId) $ do
         processAction $ MoveToLobby ("quit: " `B.append` msg)
         return ()
 
-    clientsChans <- liftM (Prelude.map sendChan . Prelude.filter logonPassed) $! allClientsS
+    clientsChans <- liftM (Prelude.map sendChan . Prelude.filter isVisible) $! allClientsS
     io $
         infoM "Clients" (show ci ++ " quits: " ++ B.unpack msg)
 
@@ -157,7 +157,7 @@
     mapM_ processAction
         [
         AnswerClients [chan] ["BYE", msg]
-        , ModifyClient (\c -> c{nick = "", logonPassed = False}) -- this will effectively hide client from others while he isn't deleted from list
+        , ModifyClient (\c -> c{nick = "", isVisible = False}) -- this will effectively hide client from others while he isn't deleted from list
         ]
 
     s <- get
@@ -445,9 +445,8 @@
     case info of
         HasAccount passwd isAdmin -> do
             b <- isBanned
-            when (not b) $ do
-                chan <- client's sendChan
-                mapM_ processAction [AnswerClients [chan] ["ASKPASSWORD"], ModifyClient (\c -> c{webPassword = passwd, isAdministrator = isAdmin})]
+            c <- client's isChecker
+            when (not b) $ (if c then checkerLogin else playerLogin) passwd isAdmin
         Guest -> do
             b <- isBanned
             when (not b) $
@@ -460,14 +459,21 @@
     isBanned = do
         processAction $ CheckBanned False
         liftM B.null $ client's nick
-
+    checkerLogin p False = processAction $ ByeClient "No checker rights"
+    checkerLogin p True = do
+        wp <- client's webPassword
+        processAction $
+            if wp == p then ModifyClient $ \c -> c{logonPassed = True} else ByeClient "Authentication failed"
+    playerLogin p a = do
+        chan <- client's sendChan
+        mapM_ processAction [AnswerClients [chan] ["ASKPASSWORD"], ModifyClient (\c -> c{webPassword = p, isAdministrator = a})]
 
 processAction JoinLobby = do
     chan <- client's sendChan
     clientNick <- client's nick
     isAuthenticated <- liftM (not . B.null) $ client's webPassword
     isAdmin <- client's isAdministrator
-    loggedInClients <- liftM (Prelude.filter logonPassed) $! allClientsS
+    loggedInClients <- liftM (Prelude.filter isVisible) $! allClientsS
     let (lobbyNicks, clientsChans) = unzip . L.map (nick &&& sendChan) $ loggedInClients
     let authenticatedNicks = L.map nick . L.filter (not . B.null . webPassword) $ loggedInClients
     let adminsNicks = L.map nick . L.filter isAdministrator $ loggedInClients
@@ -478,7 +484,7 @@
         , [AnswerClients [chan] ("CLIENT_FLAGS" : "+u" : authenticatedNicks) | not $ null authenticatedNicks]
         , [AnswerClients [chan] ("CLIENT_FLAGS" : "+a" : adminsNicks) | not $ null adminsNicks]
         , [AnswerClients (chan : clientsChans) ["CLIENT_FLAGS",  B.concat["+" , clFlags], clientNick] | not $ B.null clFlags]
-        , [ModifyClient (\cl -> cl{logonPassed = True})]
+        , [ModifyClient (\cl -> cl{logonPassed = True, isVisible = True})]
         , [SendServerMessage]
         ]
 
--- a/gameServer/CoreTypes.hs	Sat Jan 12 01:18:50 2013 +0400
+++ b/gameServer/CoreTypes.hs	Sun Jan 13 01:02:08 2013 +0400
@@ -28,6 +28,7 @@
         nick :: B.ByteString,
         webPassword :: B.ByteString,
         logonPassed :: Bool,
+        isVisible :: Bool,
         clientProto :: !Word16,
         roomID :: RoomIndex,
         pingsQueue :: !Word,
--- a/gameServer/HWProtoNEState.hs	Sat Jan 12 01:18:50 2013 +0400
+++ b/gameServer/HWProtoNEState.hs	Sun Jan 13 01:02:08 2013 +0400
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, CPP #-}
 module HWProtoNEState where
 
 import Control.Monad.Reader
@@ -48,6 +48,7 @@
         return [ByeClient "Authentication failed"]
 
 
+#if defined(OFFICIAL_SERVER)
 handleCmd_NotEntered ["CHECKER", protoNum, newNick, password] = do
     (ci, irnc) <- ask
     let cl = irnc `client` ci
@@ -59,6 +60,6 @@
             , CheckRegistered]
     where
         parsedProto = readInt_ protoNum
-
+#endif
 
 handleCmd_NotEntered _ = return [ProtocolError "Incorrect command (state: not entered)"]
--- a/gameServer/NetRoutines.hs	Sat Jan 12 01:18:50 2013 +0400
+++ b/gameServer/NetRoutines.hs	Sun Jan 13 01:02:08 2013 +0400
@@ -34,6 +34,7 @@
                     ""
                     ""
                     False
+                    False
                     0
                     lobbyId
                     0