diff -r d3966a555e5e -r 6984e15bb8f6 gameServer/Actions.hs --- a/gameServer/Actions.hs Wed Dec 05 23:55:22 2012 +0400 +++ b/gameServer/Actions.hs Thu Dec 06 00:04:23 2012 +0400 @@ -74,7 +74,7 @@ | RestartServer | AddNick2Bans B.ByteString B.ByteString UTCTime | AddIP2Bans B.ByteString B.ByteString UTCTime - | CheckBanned + | CheckBanned Bool | SaveReplay @@ -424,17 +424,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) @@ -459,7 +456,7 @@ processAction $ AnswerClients [chan] ["ADMIN_ACCESS"] where isBanned = do - processAction CheckBanned + processAction $ CheckBanned False liftM B.null $ client's nick @@ -557,7 +554,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) ] @@ -571,21 +568,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 _ _) = caseInsensitiveCompare 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