diff -r 46a9fde631f4 -r 75db7bb8dce8 gameServer/Actions.hs
--- a/gameServer/Actions.hs	Wed Jan 02 11:11:49 2013 +0100
+++ b/gameServer/Actions.hs	Sun Jan 27 00:28:57 2013 +0100
@@ -1,10 +1,10 @@
-{-# LANGUAGE CPP, OverloadedStrings #-}
+{-# LANGUAGE CPP, OverloadedStrings, ScopedTypeVariables #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Actions where
 
 import Control.Concurrent
 import qualified Data.Set as Set
-import qualified Data.Sequence as Seq
+import qualified Data.Map as Map
 import qualified Data.List as L
 import qualified Control.Exception as Exception
 import System.Log.Logger
@@ -56,7 +56,7 @@
     | BanList
     | Unban B.ByteString
     | ChangeMaster (Maybe ClientIndex)
-    | RemoveClientTeams ClientIndex
+    | RemoveClientTeams
     | ModifyClient (ClientInfo -> ClientInfo)
     | ModifyClient2 ClientIndex (ClientInfo -> ClientInfo)
     | ModifyRoomClients (ClientInfo -> ClientInfo)
@@ -76,6 +76,7 @@
     | AddIP2Bans B.ByteString B.ByteString UTCTime
     | CheckBanned Bool
     | SaveReplay
+    | Stats
 
 
 type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
@@ -84,7 +85,7 @@
     rnf (AnswerClients chans msg) = chans `deepseq` msg `deepseq` ()
     rnf a = a `seq` ()
 
-instance NFData B.ByteString
+--instance NFData B.ByteString
 instance NFData (Chan a)
 
 
@@ -143,13 +144,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)
 
@@ -158,7 +159,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
@@ -235,11 +236,11 @@
 
     if master then
         if playersNum > 1 then
-            mapM_ processAction [ChangeMaster Nothing, NoticeMessage AdminLeft, RemoveClientTeams ci, AnswerClients chans ["LEFT", clNick, msg]]
+            mapM_ processAction [ChangeMaster Nothing, NoticeMessage AdminLeft, RemoveClientTeams, AnswerClients chans ["LEFT", clNick, msg]]
             else
             processAction RemoveRoom
         else
-        mapM_ processAction [RemoveClientTeams ci, AnswerClients chans ["LEFT", clNick, msg]]
+        mapM_ processAction [RemoveClientTeams, AnswerClients chans ["LEFT", clNick, msg]]
 
     -- when not removing room
     ready <- client's isReady
@@ -374,7 +375,7 @@
         ModifyRoom (\r -> r{
                 gameInfo = liftM (\g -> g{
                     teamsInGameNumber = teamsInGameNumber g - 1
-                    , roundMsgs = roundMsgs g Seq.|> rmTeamMsg
+                    , roundMsgs = rmTeamMsg : roundMsgs g
                 }) $ gameInfo r
             })
         ]
@@ -382,16 +383,20 @@
     rnc <- gets roomsClients
     ri <- clientRoomA
     gi <- io $ room'sM rnc gameInfo ri
-    when (isJust gi && 0 == teamsInGameNumber (fromJust gi)) $
+    when (0 == teamsInGameNumber (fromJust gi)) $
         processAction FinishGame
     where
         rmTeamMsg = toEngineMsg $ 'F' `B.cons` teamName
 
 
 processAction (RemoveTeam teamName) = do
+    (Just ci) <- gets clientIndex
     rnc <- gets roomsClients
     ri <- clientRoomA
-    inGame <- io $ room'sM rnc (isJust . gameInfo) ri
+    inGame <- io $ do
+        r <- room'sM rnc (isJust . gameInfo) ri
+        c <- client'sM rnc isInGame ci
+        return $ r && c
     chans <- othersChans
     mapM_ processAction $
         ModifyRoom (\r -> r{
@@ -403,14 +408,14 @@
         : [SendTeamRemovalMessage teamName | inGame]
 
 
-processAction (RemoveClientTeams clId) = do
+processAction RemoveClientTeams = do
+    (Just ci) <- gets clientIndex
     rnc <- gets roomsClients
 
     removeTeamActions <- io $ do
-        clNick <- client'sM rnc nick clId
-        rId <- clientRoomM rnc clId
+        rId <- clientRoomM rnc ci
         roomTeams <- room'sM rnc teams rId
-        return . Prelude.map (RemoveTeam . teamname) . Prelude.filter (\t -> teamowner t == clNick) $ roomTeams
+        return . Prelude.map (RemoveTeam . teamname) . Prelude.filter (\t -> teamownerId t == ci) $ roomTeams
 
     mapM_ processAction removeTeamActions
 
@@ -421,11 +426,13 @@
     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"
+            processAction $ ByeClient $ loc "Nickname is already in use"
             else
             processAction $ NoticeMessage NickAlreadyInUse
         else
@@ -444,9 +451,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) $
@@ -459,14 +465,21 @@
     isBanned = do
         processAction $ CheckBanned False
         liftM B.null $ client's nick
-
+    checkerLogin _ False = processAction $ ByeClient $ loc "No checker rights"
+    checkerLogin p True = do
+        wp <- client's webPassword
+        processAction $
+            if wp == p then ModifyClient $ \c -> c{logonPassed = True} else ByeClient $ loc "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
@@ -477,7 +490,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]
         ]
 
@@ -487,7 +500,7 @@
     clHost <- client's host
     currentTime <- io getCurrentTime
     mapM_ processAction [
-        AddIP2Bans clHost "60 seconds cooldown after kick" (addUTCTime 60 currentTime)
+        AddIP2Bans clHost (loc "60 seconds cooldown after kick") (addUTCTime 60 currentTime)
         , ModifyClient (\c -> c{isKickedFromServer = True})
         , ByeClient "Kicked"
         ]
@@ -543,7 +556,7 @@
 processAction (KickRoomClient kickId) = do
     modify (\s -> s{clientIndex = Just kickId})
     ch <- client's sendChan
-    mapM_ processAction [AnswerClients [ch] ["KICKED"], MoveToLobby "kicked"]
+    mapM_ processAction [AnswerClients [ch] ["KICKED"], MoveToLobby $ loc "kicked"]
 
 
 processAction (AddClient cl) = do
@@ -606,7 +619,7 @@
             pq <- io $ client'sM rnc pingsQueue ci
             when (pq > 0) $ do
                 withStateT (\as -> as{clientIndex = Just ci}) $
-                    processAction (ByeClient "Ping timeout")
+                    processAction (ByeClient $ loc "Ping timeout")
 --                when (pq > 1) $
 --                    processAction $ DeleteClient ci -- smth went wrong with client io threads, issue DeleteClient here
 
@@ -633,10 +646,20 @@
             return ()
         processAction $ ModifyServerInfo (\s -> s{shutdownPending = True})
 
+processAction Stats = do
+    cls <- allClientsS
+    let stats = versions cls
+    processAction $ Warning stats
+    where
+        versions = B.concat . ((:) "<table border=1>") . (flip (++) ["</table>"])
+            . concatMap (\(p, n :: Int) -> ["<tr><td>", protoNumber2ver p, "</td><td>", showB n, "</td></tr>"])
+            . Map.toList . Map.fromListWith (+) . map (\c -> (clientProto c, 1))
+
 #if defined(OFFICIAL_SERVER)
 processAction SaveReplay = do
     ri <- clientRoomA
     rnc <- gets roomsClients
+
     io $ do
         r <- room'sM rnc id ri
         saveReplay r