diff -r d24257910f8d -r aaefa587e277 gameServer/Actions.hs --- 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