--- a/gameServer/Actions.hs Fri Oct 11 17:43:13 2013 +0200
+++ b/gameServer/Actions.hs Sat Jan 04 23:55:54 2014 +0400
@@ -21,6 +21,7 @@
import System.Process
import Network.Socket
import System.Random
+import qualified Data.Traversable as DT
-----------------------------
#if defined(OFFICIAL_SERVER)
import OfficialServer.GameReplayStore
@@ -187,13 +188,14 @@
ri <- clientRoomA
rnc <- gets roomsClients
playersNum <- io $ room'sM rnc playersIn ri
+ specialRoom <- io $ room'sM rnc isSpecial ri
master <- client's isMaster
-- client <- client's id
clNick <- client's nick
chans <- othersChans
if master then
- if playersNum > 1 then
+ if (playersNum > 1) || specialRoom then
mapM_ processAction [ChangeMaster Nothing, NoticeMessage AdminLeft, RemoveClientTeams, AnswerClients chans ["LEFT", clNick, msg]]
else
processAction RemoveRoom
@@ -205,7 +207,7 @@
-- when not removing room
ready <- client's isReady
- when (not master || playersNum > 1) . io $ do
+ when (not master || playersNum > 1 || specialRoom) . io $ do
modifyRoom rnc (\r -> r{
playersIn = playersIn r - 1,
readyPlayers = if ready then readyPlayers r - 1 else readyPlayers r
@@ -218,31 +220,40 @@
proto <- client's clientProto
ri <- clientRoomA
rnc <- gets roomsClients
- newMasterId <- liftM (\ids -> fromMaybe (last . filter (/= ci) $ ids) delegateId) . io $ roomClientsIndicesM rnc ri
- newMaster <- io $ client'sM rnc id newMasterId
+ specialRoom <- io $ room'sM rnc isSpecial ri
+ newMasterId <- liftM (\ids -> fromMaybe (listToMaybe . reverse . filter (/= ci) $ ids) $ liftM Just delegateId) . io $ roomClientsIndicesM rnc ri
+ newMaster <- io $ client'sM rnc id `DT.mapM` newMasterId
oldMasterId <- io $ room'sM rnc masterID ri
- oldMaster <- io $ client'sM rnc id oldMasterId
oldRoomName <- io $ room'sM rnc name ri
kicked <- client's isKickedFromServer
thisRoomChans <- liftM (map sendChan) $ roomClientsS ri
- let newRoomName = if (proto < 42) || kicked then nick newMaster else oldRoomName
- mapM_ processAction [
+ let newRoomName = if ((proto < 42) || kicked) && (not specialRoom) then maybeNick newMaster else oldRoomName
+
+ when (isJust oldMasterId) $ do
+ oldMasterNick <- io $ client'sM rnc nick (fromJust oldMasterId)
+ mapM_ processAction [
+ ModifyClient2 (fromJust oldMasterId) (\c -> c{isMaster = False})
+ , AnswerClients thisRoomChans ["CLIENT_FLAGS", "-h", oldMasterNick]
+ ]
+
+ when (isJust newMasterId) $
+ mapM_ processAction [
+ ModifyClient2 (fromJust newMasterId) (\c -> c{isMaster = True})
+ , AnswerClients [sendChan $ fromJust newMaster] ["ROOM_CONTROL_ACCESS", "1"]
+ , AnswerClients thisRoomChans ["CLIENT_FLAGS", "+h", nick $ fromJust newMaster]
+ ]
+
+ processAction $
ModifyRoom (\r -> r{masterID = newMasterId
, name = newRoomName
, isRestrictedJoins = False
, isRestrictedTeams = False
- , isRegisteredOnly = False}
+ , isRegisteredOnly = isSpecial r}
)
- , ModifyClient2 newMasterId (\c -> c{isMaster = True})
- , ModifyClient2 oldMasterId (\c -> c{isMaster = False})
- , AnswerClients [sendChan newMaster] ["ROOM_CONTROL_ACCESS", "1"]
- , AnswerClients thisRoomChans ["CLIENT_FLAGS", "-h", nick oldMaster]
- , AnswerClients thisRoomChans ["CLIENT_FLAGS", "+h", nick newMaster]
- ]
newRoom' <- io $ room'sM rnc id ri
chans <- liftM (map sendChan) $! sameProtoClientsS proto
- processAction $ AnswerClients chans ("ROOM" : "UPD" : oldRoomName : roomInfo (nick newMaster) newRoom')
+ processAction $ AnswerClients chans ("ROOM" : "UPD" : oldRoomName : roomInfo proto (maybeNick newMaster) newRoom')
processAction (AddRoom roomName roomPassword) = do
@@ -252,7 +263,7 @@
n <- client's nick
let rm = newRoom{
- masterID = clId,
+ masterID = Just clId,
name = roomName,
password = roomPassword,
roomProto = proto
@@ -265,7 +276,7 @@
chans <- liftM (map sendChan) $! sameProtoClientsS proto
mapM_ processAction [
- AnswerClients chans ("ROOM" : "ADD" : roomInfo n rm{playersIn = 1})
+ AnswerClients chans ("ROOM" : "ADD" : roomInfo proto n rm{playersIn = 1})
]
@@ -292,9 +303,9 @@
rnc <- gets roomsClients
ri <- io $ clientRoomM rnc clId
rm <- io $ room'sM rnc id ri
- n <- io $ client'sM rnc nick (masterID rm)
+ masterCl <- io $ client'sM rnc id `DT.mapM` (masterID rm)
chans <- liftM (map sendChan) $! sameProtoClientsS proto
- processAction $ AnswerClients chans ("ROOM" : "UPD" : name rm : roomInfo n rm)
+ processAction $ AnswerClients chans ("ROOM" : "UPD" : name rm : roomInfo proto (maybeNick masterCl) rm)
processAction UnreadyRoomClients = do
@@ -433,10 +444,8 @@
checkerLogin "" False False
else
processAction JoinLobby
- Admin -> do
+ Admin ->
mapM_ processAction [ModifyClient (\cl -> cl{isAdministrator = True}), JoinLobby]
- chan <- client's sendChan
- processAction $ AnswerClients [chan] ["ADMIN_ACCESS"]
ReplayName fn -> processAction $ ShowReplay fn
where
isBanned = do
@@ -456,6 +465,7 @@
processAction JoinLobby = do
chan <- client's sendChan
+ rnc <- gets roomsClients
clientNick <- client's nick
isAuthenticated <- liftM (not . B.null) $ client's webPassword
isAdmin <- client's isAdministrator
@@ -465,6 +475,10 @@
let authenticatedNicks = L.map nick . L.filter (not . B.null . webPassword) $ loggedInClients
let adminsNicks = L.map nick . L.filter isAdministrator $ loggedInClients
let contrNicks = L.map nick . L.filter isContributor $ loggedInClients
+ inRoomNicks <- io $
+ allClientsM rnc
+ >>= filterM (liftM ((/=) lobbyId) . clientRoomM rnc)
+ >>= mapM (client'sM rnc nick)
let clFlags = B.concat . L.concat $ [["u" | isAuthenticated], ["a" | isAdmin], ["c" | isContr]]
mapM_ processAction . concat $ [
[AnswerClients clientsChans ["LOBBY:JOINED", clientNick]]
@@ -472,6 +486,7 @@
, [AnswerClients [chan] ("CLIENT_FLAGS" : "+u" : authenticatedNicks) | not $ null authenticatedNicks]
, [AnswerClients [chan] ("CLIENT_FLAGS" : "+a" : adminsNicks) | not $ null adminsNicks]
, [AnswerClients [chan] ("CLIENT_FLAGS" : "+c" : contrNicks) | not $ null contrNicks]
+ , [AnswerClients [chan] ("CLIENT_FLAGS" : "+i" : inRoomNicks) | not $ null inRoomNicks]
, [AnswerClients (chan : clientsChans) ["CLIENT_FLAGS", B.concat["+" , clFlags], clientNick] | not $ B.null clFlags]
, [ModifyClient (\cl -> cl{logonPassed = True, isVisible = True})]
, [SendServerMessage]
@@ -678,7 +693,16 @@
processAction CheckRecord = do
p <- client's clientProto
c <- client's sendChan
- (cinfo, l) <- io $ loadReplay (fromIntegral p)
+ ri <- clientRoomA
+ rnc <- gets roomsClients
+
+ blackList <- liftM (map (recordFileName . fromJust . checkInfo) . filter (isJust . checkInfo)) allClientsS
+
+ readyCheckersIds <- io $ do
+ allci <- allClientsM rnc
+ filterM (client'sM rnc (isJust . checkInfo)) allci
+
+ (cinfo, l) <- io $ loadReplay (fromIntegral p) blackList
when (not . null $ l) $
mapM_ processAction [
AnswerClients [c] ("REPLAY" : l)
@@ -693,17 +717,18 @@
processAction (CheckSuccess info) = do
Just (CheckInfo fileName teams) <- client's checkInfo
+ p <- client's clientProto
si <- gets serverInfo
- io $ writeChan (dbQueries si) $ StoreAchievements (B.pack fileName) (map toPair teams) info
+ io $ writeChan (dbQueries si) $ StoreAchievements p (B.pack fileName) (map toPair teams) info
io $ moveCheckedRecord fileName
where
toPair t = (teamname t, teamowner t)
-processAction (QueryReplay name) = do
+processAction (QueryReplay rname) = do
(Just ci) <- gets clientIndex
si <- gets serverInfo
uid <- client's clUID
- io $ writeChan (dbQueries si) $ GetReplayName ci (hashUnique uid) name
+ io $ writeChan (dbQueries si) $ GetReplayName ci (hashUnique uid) rname
#else
processAction SaveReplay = return ()
@@ -713,25 +738,25 @@
processAction (QueryReplay _) = return ()
#endif
-processAction (ShowReplay name) = do
+processAction (ShowReplay rname) = do
c <- client's sendChan
cl <- client's id
- let fileName = B.concat ["checked/", if B.isPrefixOf "replays/" name then B.drop 8 name else name]
+ let fileName = B.concat ["checked/", if B.isPrefixOf "replays/" rname then B.drop 8 rname else rname]
- checkInfo <- liftIO $ E.handle (\(e :: SomeException) ->
+ cInfo <- liftIO $ E.handle (\(e :: SomeException) ->
warningM "REPLAYS" (B.unpack $ B.concat ["Problems reading ", fileName, ": ", B.pack $ show e]) >> return Nothing) $ do
(t, p1, p2, msgs) <- liftM read $ readFile (B.unpack fileName)
return $ Just (t, Map.fromList p1, Map.fromList p2, reverse msgs)
- let (teams, params1, params2, roundMsgs) = fromJust checkInfo
+ let (teams', params1, params2, roundMsgs') = fromJust cInfo
- when (isJust checkInfo) $ do
+ when (isJust cInfo) $ do
mapM_ processAction $ concat [
[AnswerClients [c] ["JOINED", nick cl]]
, answerFullConfigParams cl params1 params2
- , answerAllTeams cl teams
+ , answerAllTeams cl teams'
, [AnswerClients [c] ["RUN_GAME"]]
- , [AnswerClients [c] $ "EM" : roundMsgs]
+ , [AnswerClients [c] $ "EM" : roundMsgs']
, [AnswerClients [c] ["KICKED"]]
]