--- 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