--- a/gameServer/Actions.hs Sun Dec 02 00:03:16 2012 +0100
+++ b/gameServer/Actions.hs Tue Dec 25 04:45:22 2012 +0100
@@ -52,9 +52,10 @@
| KickRoomClient ClientIndex
| BanClient NominalDiffTime B.ByteString ClientIndex
| BanIP B.ByteString NominalDiffTime B.ByteString
+ | BanNick B.ByteString NominalDiffTime B.ByteString
| BanList
| Unban B.ByteString
- | ChangeMaster
+ | ChangeMaster (Maybe ClientIndex)
| RemoveClientTeams ClientIndex
| ModifyClient (ClientInfo -> ClientInfo)
| ModifyClient2 ClientIndex (ClientInfo -> ClientInfo)
@@ -73,7 +74,7 @@
| RestartServer
| AddNick2Bans B.ByteString B.ByteString UTCTime
| AddIP2Bans B.ByteString B.ByteString UTCTime
- | CheckBanned
+ | CheckBanned Bool
| SaveReplay
@@ -154,7 +155,7 @@
when loggedIn $ processAction $ AnswerClients clientsChans ["LOBBY:LEFT", clNick, msg]
- mapM processAction
+ 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
@@ -234,7 +235,7 @@
if master then
if playersNum > 1 then
- mapM_ processAction [ChangeMaster, NoticeMessage AdminLeft, RemoveClientTeams ci, AnswerClients chans ["LEFT", clNick, msg]]
+ mapM_ processAction [ChangeMaster Nothing, NoticeMessage AdminLeft, RemoveClientTeams ci, AnswerClients chans ["LEFT", clNick, msg]]
else
processAction RemoveRoom
else
@@ -250,26 +251,27 @@
moveClientToLobby rnc ci
-processAction ChangeMaster = do
+processAction (ChangeMaster delegateId)= do
(Just ci) <- gets clientIndex
proto <- client's clientProto
ri <- clientRoomA
rnc <- gets roomsClients
- newMasterId <- liftM (last . filter (/= ci)) . io $ roomClientsIndicesM rnc ri
+ newMasterId <- liftM (\ids -> fromMaybe (last . filter (/= ci) $ ids) delegateId) . io $ roomClientsIndicesM rnc ri
newMaster <- io $ client'sM rnc id newMasterId
oldRoomName <- io $ room'sM rnc name ri
oldMaster <- client's nick
+ kicked <- client's isKickedFromServer
thisRoomChans <- liftM (map sendChan) $ roomClientsS ri
- let newRoomName = if proto < 42 then nick newMaster else oldRoomName
+ let newRoomName = if (proto < 42) || kicked then nick newMaster else oldRoomName
mapM_ processAction [
ModifyRoom (\r -> r{masterID = newMasterId
, name = newRoomName
, isRestrictedJoins = False
, isRestrictedTeams = False
+ , isRegisteredOnly = False
, readyPlayers = if isReady newMaster then readyPlayers r else readyPlayers r + 1})
, ModifyClient2 newMasterId (\c -> c{isMaster = True, isReady = True})
, AnswerClients [sendChan newMaster] ["ROOM_CONTROL_ACCESS", "1"]
- , AnswerClients thisRoomChans ["WARNING", "New room admin is " `B.append` nick newMaster]
, AnswerClients thisRoomChans ["CLIENT_FLAGS", "-h", oldMaster]
, AnswerClients thisRoomChans ["CLIENT_FLAGS", "+hr", nick newMaster]
]
@@ -361,6 +363,7 @@
)
: UnreadyRoomClients
: SendUpdateOnThisRoom
+ : AnswerClients thisRoomChans ["ROUND_FINISHED"]
: answerRemovedTeams
@@ -422,17 +425,14 @@
haveSameNick <- liftM (not . null . tail . filter (\c -> caseInsensitiveCompare (nick c) n)) allClientsS
if haveSameNick then
if p < 38 then
- mapM_ processAction [ByeClient "Nickname is already in use", removeNick]
+ processAction $ ByeClient "Nickname is already in use"
else
- mapM_ processAction [NoticeMessage NickAlreadyInUse, removeNick]
+ processAction $ NoticeMessage NickAlreadyInUse
else
do
db <- gets (dbQueries . serverInfo)
io $ writeChan db $ CheckAccount ci (hashUnique uid) n h
return ()
- where
- removeNick = ModifyClient (\c -> c{nick = ""})
-
processAction ClearAccountsCache = do
dbq <- gets (dbQueries . serverInfo)
@@ -440,17 +440,25 @@
return ()
-processAction (ProcessAccountInfo info) =
+processAction (ProcessAccountInfo info) = do
case info of
HasAccount passwd isAdmin -> do
- chan <- client's sendChan
- mapM_ processAction [AnswerClients [chan] ["ASKPASSWORD"], ModifyClient (\c -> c{webPassword = passwd, isAdministrator = isAdmin})]
- Guest ->
- processAction JoinLobby
+ b <- isBanned
+ when (not b) $ do
+ chan <- client's sendChan
+ mapM_ processAction [AnswerClients [chan] ["ASKPASSWORD"], ModifyClient (\c -> c{webPassword = passwd, isAdministrator = isAdmin})]
+ Guest -> do
+ b <- isBanned
+ when (not b) $
+ processAction JoinLobby
Admin -> do
mapM_ processAction [ModifyClient (\cl -> cl{isAdministrator = True}), JoinLobby]
chan <- client's sendChan
processAction $ AnswerClients [chan] ["ADMIN_ACCESS"]
+ where
+ isBanned = do
+ processAction $ CheckBanned False
+ liftM B.null $ client's nick
processAction JoinLobby = do
@@ -479,8 +487,9 @@
clHost <- client's host
currentTime <- io getCurrentTime
mapM_ processAction [
- AddIP2Bans clHost "60 seconds cooldown after kick" (addUTCTime 60 currentTime),
- ByeClient "Kicked"
+ AddIP2Bans clHost "60 seconds cooldown after kick" (addUTCTime 60 currentTime)
+ , ModifyClient (\c -> c{isKickedFromServer = True})
+ , ByeClient "Kicked"
]
@@ -494,24 +503,43 @@
, KickClient banId
]
+
processAction (BanIP ip seconds reason) = do
currentTime <- io getCurrentTime
let msg = B.concat ["Ban for ", B.pack . show $ seconds, " (", reason, ")"]
processAction $
AddIP2Bans ip msg (addUTCTime seconds currentTime)
+
+processAction (BanNick n seconds reason) = do
+ currentTime <- io getCurrentTime
+ let msg =
+ if seconds > 60 * 60 * 24 * 365 then
+ B.concat ["Permanent ban (", reason, ")"]
+ else
+ B.concat ["Ban for ", B.pack . show $ seconds, " (", reason, ")"]
+ processAction $
+ AddNick2Bans n msg (addUTCTime seconds currentTime)
+
+
processAction BanList = do
+ time <- io $ getCurrentTime
ch <- client's sendChan
- b <- gets (B.pack . unlines . map show . bans . serverInfo)
+ b <- gets (B.intercalate "\n" . concatMap (ban2Str time) . bans . serverInfo)
processAction $
AnswerClients [ch] ["BANLIST", b]
+ where
+ ban2Str time (BanByIP b r t) = ["I", b, r, B.pack . show $ t `diffUTCTime` time]
+ ban2Str time (BanByNick b r t) = ["N", b, r, B.pack . show $ t `diffUTCTime` time]
+
processAction (Unban entry) = do
- processAction $ ModifyServerInfo (\s -> s{bans = filter f $ bans s})
+ processAction $ ModifyServerInfo (\s -> s{bans = filter (not . f) $ bans s})
where
f (BanByIP bip _ _) = bip == entry
f (BanByNick bn _ _) = bn == entry
+
processAction (KickRoomClient kickId) = do
modify (\s -> s{clientIndex = Just kickId})
ch <- client's sendChan
@@ -533,7 +561,7 @@
mapM_ processAction
[
AnswerClients [sendChan cl] ["CONNECTED", "Hedgewars server http://www.hedgewars.org/", serverVersion]
- , CheckBanned
+ , CheckBanned True
, AddIP2Bans (host cl) "Reconnected too fast" (addUTCTime 10 $ connectTime cl)
]
@@ -547,21 +575,22 @@
when (not $ ci `Set.member` rc)
$ processAction $ ModifyServerInfo (\s -> s{bans = BanByIP ip reason expiring : bans s})
-processAction CheckBanned = do
+processAction (CheckBanned byIP) = do
clTime <- client's connectTime
clNick <- client's nick
clHost <- client's host
si <- gets serverInfo
let validBans = filter (checkNotExpired clTime) $ bans si
- let ban = L.find (checkBan clHost clNick) $ validBans
+ let ban = L.find (checkBan byIP clHost clNick) $ validBans
mapM_ processAction $
ModifyServerInfo (\s -> s{bans = validBans})
: [ByeClient (getBanReason $ fromJust ban) | isJust ban]
where
checkNotExpired testTime (BanByIP _ _ time) = testTime `diffUTCTime` time <= 0
checkNotExpired testTime (BanByNick _ _ time) = testTime `diffUTCTime` time <= 0
- checkBan ip _ (BanByIP bip _ _) = bip `B.isPrefixOf` ip
- checkBan _ n (BanByNick bn _ _) = bn == n
+ checkBan True ip _ (BanByIP bip _ _) = bip `B.isPrefixOf` ip
+ checkBan False _ n (BanByNick bn _ _) = caseInsensitiveCompare bn n
+ checkBan _ _ _ _ = False
getBanReason (BanByIP _ msg _) = msg
getBanReason (BanByNick _ msg _) = msg