gameServer/Actions.hs
branchflibqtfrontend
changeset 8242 6735a8ce1946
parent 8238 5c3337d05151
child 8244 0f8893faeb00
equal deleted inserted replaced
8240:ee39403a1d27 8242:6735a8ce1946
   258     rnc <- gets roomsClients
   258     rnc <- gets roomsClients
   259     newMasterId <- liftM (last . filter (/= ci)) . io $ roomClientsIndicesM rnc ri
   259     newMasterId <- liftM (last . filter (/= ci)) . io $ roomClientsIndicesM rnc ri
   260     newMaster <- io $ client'sM rnc id newMasterId
   260     newMaster <- io $ client'sM rnc id newMasterId
   261     oldRoomName <- io $ room'sM rnc name ri
   261     oldRoomName <- io $ room'sM rnc name ri
   262     oldMaster <- client's nick
   262     oldMaster <- client's nick
       
   263     kicked <- client's isKickedFromServer
   263     thisRoomChans <- liftM (map sendChan) $ roomClientsS ri
   264     thisRoomChans <- liftM (map sendChan) $ roomClientsS ri
   264     let newRoomName = if proto < 42 then nick newMaster else oldRoomName
   265     let newRoomName = if (proto < 42) || kicked then nick newMaster else oldRoomName
   265     mapM_ processAction [
   266     mapM_ processAction [
   266         ModifyRoom (\r -> r{masterID = newMasterId
   267         ModifyRoom (\r -> r{masterID = newMasterId
   267                 , name = newRoomName
   268                 , name = newRoomName
   268                 , isRestrictedJoins = False
   269                 , isRestrictedJoins = False
   269                 , isRestrictedTeams = False
   270                 , isRestrictedTeams = False
   270                 , isRegisteredOnly = False
   271                 , isRegisteredOnly = False
   271                 , readyPlayers = if isReady newMaster then readyPlayers r else readyPlayers r + 1})
   272                 , readyPlayers = if isReady newMaster then readyPlayers r else readyPlayers r + 1})
   272         , ModifyClient2 newMasterId (\c -> c{isMaster = True, isReady = True})
   273         , ModifyClient2 newMasterId (\c -> c{isMaster = True, isReady = True})
   273         , AnswerClients [sendChan newMaster] ["ROOM_CONTROL_ACCESS", "1"]
   274         , AnswerClients [sendChan newMaster] ["ROOM_CONTROL_ACCESS", "1"]
   274         , AnswerClients thisRoomChans ["WARNING", "New room admin is " `B.append` nick newMaster]
       
   275         , AnswerClients thisRoomChans ["CLIENT_FLAGS", "-h", oldMaster]
   275         , AnswerClients thisRoomChans ["CLIENT_FLAGS", "-h", oldMaster]
   276         , AnswerClients thisRoomChans ["CLIENT_FLAGS", "+hr", nick newMaster]
   276         , AnswerClients thisRoomChans ["CLIENT_FLAGS", "+hr", nick newMaster]
   277         ]
   277         ]
   278 
   278 
   279     newRoom' <- io $ room'sM rnc id ri
   279     newRoom' <- io $ room'sM rnc id ri
   485 processAction (KickClient kickId) = do
   485 processAction (KickClient kickId) = do
   486     modify (\s -> s{clientIndex = Just kickId})
   486     modify (\s -> s{clientIndex = Just kickId})
   487     clHost <- client's host
   487     clHost <- client's host
   488     currentTime <- io getCurrentTime
   488     currentTime <- io getCurrentTime
   489     mapM_ processAction [
   489     mapM_ processAction [
   490         AddIP2Bans clHost "60 seconds cooldown after kick" (addUTCTime 60 currentTime),
   490         AddIP2Bans clHost "60 seconds cooldown after kick" (addUTCTime 60 currentTime)
   491         ByeClient "Kicked"
   491         , ModifyClient (\c -> c{isKickedFromServer = True})
       
   492         , ByeClient "Kicked"
   492         ]
   493         ]
   493 
   494 
   494 
   495 
   495 processAction (BanClient seconds reason banId) = do
   496 processAction (BanClient seconds reason banId) = do
   496     modify (\s -> s{clientIndex = Just banId})
   497     modify (\s -> s{clientIndex = Just banId})
   500     mapM_ processAction [
   501     mapM_ processAction [
   501         AddIP2Bans clHost msg (addUTCTime seconds currentTime)
   502         AddIP2Bans clHost msg (addUTCTime seconds currentTime)
   502         , KickClient banId
   503         , KickClient banId
   503         ]
   504         ]
   504 
   505 
       
   506 
   505 processAction (BanIP ip seconds reason) = do
   507 processAction (BanIP ip seconds reason) = do
   506     currentTime <- io getCurrentTime
   508     currentTime <- io getCurrentTime
   507     let msg = B.concat ["Ban for ", B.pack . show $ seconds, " (", reason, ")"]
   509     let msg = B.concat ["Ban for ", B.pack . show $ seconds, " (", reason, ")"]
   508     processAction $
   510     processAction $
   509         AddIP2Bans ip msg (addUTCTime seconds currentTime)
   511         AddIP2Bans ip msg (addUTCTime seconds currentTime)
       
   512 
   510 
   513 
   511 processAction (BanNick n seconds reason) = do
   514 processAction (BanNick n seconds reason) = do
   512     currentTime <- io getCurrentTime
   515     currentTime <- io getCurrentTime
   513     let msg = 
   516     let msg = 
   514             if seconds > 60 * 60 * 24 * 365 then
   517             if seconds > 60 * 60 * 24 * 365 then
   516                 else
   519                 else
   517                 B.concat ["Ban for ", B.pack . show $ seconds, " (", reason, ")"]
   520                 B.concat ["Ban for ", B.pack . show $ seconds, " (", reason, ")"]
   518     processAction $
   521     processAction $
   519         AddNick2Bans n msg (addUTCTime seconds currentTime)
   522         AddNick2Bans n msg (addUTCTime seconds currentTime)
   520 
   523 
       
   524 
   521 processAction BanList = do
   525 processAction BanList = do
   522     time <- io $ getCurrentTime
   526     time <- io $ getCurrentTime
   523     ch <- client's sendChan
   527     ch <- client's sendChan
   524     b <- gets (B.intercalate "\n" . concatMap (ban2Str time) . bans . serverInfo)
   528     b <- gets (B.intercalate "\n" . concatMap (ban2Str time) . bans . serverInfo)
   525     processAction $
   529     processAction $
   526         AnswerClients [ch] ["BANLIST", b]
   530         AnswerClients [ch] ["BANLIST", b]
   527     where
   531     where
   528         ban2Str time (BanByIP b r t) = ["I", b, r, B.pack . show $ t `diffUTCTime` time]
   532         ban2Str time (BanByIP b r t) = ["I", b, r, B.pack . show $ t `diffUTCTime` time]
   529         ban2Str time (BanByNick b r t) = ["N", b, r, B.pack . show $ t `diffUTCTime` time]
   533         ban2Str time (BanByNick b r t) = ["N", b, r, B.pack . show $ t `diffUTCTime` time]
   530 
   534 
       
   535 
   531 processAction (Unban entry) = do
   536 processAction (Unban entry) = do
   532     processAction $ ModifyServerInfo (\s -> s{bans = filter (not . f) $ bans s})
   537     processAction $ ModifyServerInfo (\s -> s{bans = filter (not . f) $ bans s})
   533     where
   538     where
   534         f (BanByIP bip _ _) = bip == entry
   539         f (BanByIP bip _ _) = bip == entry
   535         f (BanByNick bn _ _) = bn == entry
   540         f (BanByNick bn _ _) = bn == entry
       
   541 
   536 
   542 
   537 processAction (KickRoomClient kickId) = do
   543 processAction (KickRoomClient kickId) = do
   538     modify (\s -> s{clientIndex = Just kickId})
   544     modify (\s -> s{clientIndex = Just kickId})
   539     ch <- client's sendChan
   545     ch <- client's sendChan
   540     mapM_ processAction [AnswerClients [ch] ["KICKED"], MoveToLobby "kicked"]
   546     mapM_ processAction [AnswerClients [ch] ["KICKED"], MoveToLobby "kicked"]