3 |
3 |
4 import Control.Concurrent |
4 import Control.Concurrent |
5 import qualified Data.Set as Set |
5 import qualified Data.Set as Set |
6 import qualified Data.Sequence as Seq |
6 import qualified Data.Sequence as Seq |
7 import qualified Data.List as L |
7 import qualified Data.List as L |
|
8 import qualified Control.Exception as Exception |
8 import System.Log.Logger |
9 import System.Log.Logger |
9 import Control.Monad |
10 import Control.Monad |
10 import Data.Time |
11 import Data.Time |
11 import Data.Maybe |
12 import Data.Maybe |
12 import Control.Monad.Reader |
13 import Control.Monad.Reader |
392 processAction (AddClient cl) = do |
393 processAction (AddClient cl) = do |
393 rnc <- gets roomsClients |
394 rnc <- gets roomsClients |
394 si <- gets serverInfo |
395 si <- gets serverInfo |
395 newClId <- io $ do |
396 newClId <- io $ do |
396 ci <- addClient rnc cl |
397 ci <- addClient rnc cl |
397 t <- forkIO $ clientRecvLoop (clientSocket cl) (coreChan si) ci |
398 _ <- Exception.block . forkIO $ clientRecvLoop (clientSocket cl) (coreChan si) (sendChan cl) ci |
398 _ <- forkIO $ clientSendLoop (clientSocket cl) t (coreChan si) (sendChan cl) ci |
|
399 |
399 |
400 infoM "Clients" (show ci ++ ": New client. Time: " ++ show (connectTime cl)) |
400 infoM "Clients" (show ci ++ ": New client. Time: " ++ show (connectTime cl)) |
401 |
401 |
402 return ci |
402 return ci |
403 |
403 |
404 modify (\s -> s{clientIndex = Just newClId}) |
404 modify (\s -> s{clientIndex = Just newClId}) |
405 mapM_ processAction |
405 mapM_ processAction |
406 [ |
406 [ |
407 AnswerClients [sendChan cl] ["CONNECTED", "Hedgewars server http://www.hedgewars.org/", serverVersion] |
407 AnswerClients [sendChan cl] ["CONNECTED", "Hedgewars server http://www.hedgewars.org/", serverVersion] |
408 , CheckBanned |
408 , CheckBanned |
409 , AddIP2Bans (host cl) "Reconnected too fast" (addUTCTime 10 $ connectTime cl) |
409 -- , AddIP2Bans (host cl) "Reconnected too fast" (addUTCTime 10 $ connectTime cl) |
410 ] |
410 ] |
411 |
411 |
412 |
412 |
413 processAction (AddNick2Bans n reason expiring) = do |
413 processAction (AddNick2Bans n reason expiring) = do |
414 processAction $ ModifyServerInfo (\s -> s{bans = BanByNick n reason expiring : bans s}) |
414 processAction $ ModifyServerInfo (\s -> s{bans = BanByNick n reason expiring : bans s}) |