- Start work on checker
authorunc0rr
Sat, 12 Jan 2013 01:18:50 +0400
changeset 8371 0551b5c3de9a
parent 8370 0c79946e96f8
child 8372 3c193ec03e09
- Start work on checker - Various small fixes
gameServer/Actions.hs
gameServer/ClientIO.hs
gameServer/CoreTypes.hs
gameServer/HWProtoNEState.hs
gameServer/NetRoutines.hs
gameServer/OfficialServer/GameReplayStore.hs
gameServer/ServerState.hs
--- a/gameServer/Actions.hs	Thu Jan 10 22:59:46 2013 +0400
+++ b/gameServer/Actions.hs	Sat Jan 12 01:18:50 2013 +0400
@@ -420,9 +420,11 @@
     n <- client's nick
     h <- client's host
     p <- client's clientProto
+    checker <- client's isChecker
     uid <- client's clUID
-    haveSameNick <- liftM (not . null . tail . filter (\c -> caseInsensitiveCompare (nick c) n)) allClientsS
-    if haveSameNick then
+    -- allow multiple checker logins
+    haveSameNick <- liftM (not . null . tail . filter (\c -> (not $ isChecker c) && caseInsensitiveCompare (nick c) n)) allClientsS
+    if haveSameNick && (not checker) then
         if p < 38 then
             processAction $ ByeClient "Nickname is already in use"
             else
@@ -636,6 +638,7 @@
 processAction SaveReplay = do
     ri <- clientRoomA
     rnc <- gets roomsClients
+
     io $ do
         r <- room'sM rnc id ri
         saveReplay r
--- a/gameServer/ClientIO.hs	Thu Jan 10 22:59:46 2013 +0400
+++ b/gameServer/ClientIO.hs	Sat Jan 12 01:18:50 2013 +0400
@@ -30,25 +30,26 @@
             return (B.splitWith (== '\n') packet : packets)
 
 listenLoop :: Socket -> Chan CoreMessage -> ClientIndex -> IO ()
-listenLoop sock chan ci = recieveWithBufferLoop B.empty
+listenLoop sock chan ci = receiveWithBufferLoop B.empty
     where
-        recieveWithBufferLoop recvBuf = do
+        receiveWithBufferLoop recvBuf = do
             recvBS <- recv sock 4096
             unless (B.null recvBS) $ do
                 let (packets, newrecvBuf) = bs2Packets $ B.append recvBuf recvBS
                 forM_ packets sendPacket
-                recieveWithBufferLoop newrecvBuf
+                receiveWithBufferLoop newrecvBuf
 
         sendPacket packet = writeChan chan $ ClientMessage (ci, packet)
 
 clientRecvLoop :: Socket -> Chan CoreMessage -> Chan [B.ByteString] -> ClientIndex -> (forall a. IO a -> IO a) -> IO ()
 clientRecvLoop s chan clChan ci restore =
     (myThreadId >>=
-    \t -> (restore $ forkIO (clientSendLoop s t clChan ci) >>
+      (\t -> (restore $ forkIO (clientSendLoop s t clChan ci) >>
         listenLoop s chan ci >> return "Connection closed")
         `Exception.catch` (\(e :: ShutdownThreadException) -> return . B.pack . show $ e)
         `Exception.catch` (\(e :: Exception.IOException) -> return . B.pack . show $ e)
         `Exception.catch` (\(e :: Exception.SomeException) -> return . B.pack . show $ e)
+      )
         >>= clientOff) `Exception.finally` remove
     where
         clientOff msg = writeChan chan $ ClientMessage (ci, ["QUIT", msg])
--- a/gameServer/CoreTypes.hs	Thu Jan 10 22:59:46 2013 +0400
+++ b/gameServer/CoreTypes.hs	Sat Jan 12 01:18:50 2013 +0400
@@ -35,6 +35,7 @@
         isReady :: !Bool,
         isInGame :: Bool,
         isAdministrator :: Bool,
+        isChecker :: Bool,
         isKickedFromServer :: Bool,
         clientClan :: Maybe B.ByteString,
         teamsInGame :: Word
--- a/gameServer/HWProtoNEState.hs	Thu Jan 10 22:59:46 2013 +0400
+++ b/gameServer/HWProtoNEState.hs	Sat Jan 12 01:18:50 2013 +0400
@@ -48,4 +48,17 @@
         return [ByeClient "Authentication failed"]
 
 
+handleCmd_NotEntered ["CHECKER", protoNum, newNick, password] = do
+    (ci, irnc) <- ask
+    let cl = irnc `client` ci
+
+    if parsedProto == 0 then return [ProtocolError "Bad number"]
+        else
+        return $ [
+            ModifyClient (\c -> c{clientProto = parsedProto, nick = newNick, webPassword = password, isChecker = True})
+            , CheckRegistered]
+    where
+        parsedProto = readInt_ protoNum
+
+
 handleCmd_NotEntered _ = return [ProtocolError "Incorrect command (state: not entered)"]
--- a/gameServer/NetRoutines.hs	Thu Jan 10 22:59:46 2013 +0400
+++ b/gameServer/NetRoutines.hs	Sat Jan 12 01:18:50 2013 +0400
@@ -42,6 +42,7 @@
                     False
                     False
                     False
+                    False
                     Nothing
                     0
                     )
--- a/gameServer/OfficialServer/GameReplayStore.hs	Thu Jan 10 22:59:46 2013 +0400
+++ b/gameServer/OfficialServer/GameReplayStore.hs	Sat Jan 12 01:18:50 2013 +0400
@@ -14,7 +14,7 @@
 
 
 saveReplay :: RoomInfo -> IO ()
-saveReplay r = do
+saveReplay r = when allPlayersHaveRegisteredAccounts $ do
     time <- getCurrentTime
     u <- liftM hashUnique newUnique
     let fileName = "replays/" ++ show time ++ "-" ++ show u
@@ -23,4 +23,3 @@
     E.catch
         (writeFile fileName (show replayInfo))
         (\(e :: IOException) -> warningM "REPLAYS" $ "Couldn't write to " ++ fileName ++ ": " ++ show e)
-                   
\ No newline at end of file
--- a/gameServer/ServerState.hs	Thu Jan 10 22:59:46 2013 +0400
+++ b/gameServer/ServerState.hs	Sat Jan 12 01:18:50 2013 +0400
@@ -49,6 +49,6 @@
 sameProtoClientsS p = liftM f allClientsS
     where
         f = filter (\c -> clientProto c == p)
-    
+
 io :: IO a -> StateT ServerState IO a
 io = liftIO