34 | Warning B.ByteString |
36 | Warning B.ByteString |
35 | NoticeMessage Notice |
37 | NoticeMessage Notice |
36 | ByeClient B.ByteString |
38 | ByeClient B.ByteString |
37 | KickClient ClientIndex |
39 | KickClient ClientIndex |
38 | KickRoomClient ClientIndex |
40 | KickRoomClient ClientIndex |
39 | BanClient B.ByteString |
41 | BanClient NominalDiffTime B.ByteString ClientIndex |
40 | ChangeMaster |
42 | ChangeMaster |
41 | RemoveClientTeams ClientIndex |
43 | RemoveClientTeams ClientIndex |
42 | ModifyClient (ClientInfo -> ClientInfo) |
44 | ModifyClient (ClientInfo -> ClientInfo) |
43 | ModifyClient2 ClientIndex (ClientInfo -> ClientInfo) |
45 | ModifyClient2 ClientIndex (ClientInfo -> ClientInfo) |
44 | ModifyRoom (RoomInfo -> RoomInfo) |
46 | ModifyRoom (RoomInfo -> RoomInfo) |
351 client = clients ! clID |
353 client = clients ! clID |
352 joinMsg = if rID == 0 then |
354 joinMsg = if rID == 0 then |
353 AnswerAllOthers ["LOBBY:JOINED", nick client] |
355 AnswerAllOthers ["LOBBY:JOINED", nick client] |
354 else |
356 else |
355 AnswerThisRoom ["JOINED", nick client] |
357 AnswerThisRoom ["JOINED", nick client] |
356 |
358 -} |
357 processAction (clID, serverInfo, rnc) (KickClient kickID) = |
359 processAction (KickClient kickId) = do |
358 liftM2 replaceID (return clID) (processAction (kickID, serverInfo, rnc) $ ByeClient "Kicked") |
360 modify (\s -> s{clientIndex = Just kickId}) |
359 |
361 processAction $ ByeClient "Kicked" |
360 |
362 |
361 processAction (clID, serverInfo, rnc) (BanClient banNick) = |
363 |
362 return (clID, serverInfo, rnc) |
364 processAction (BanClient seconds reason banId) = do |
363 |
365 modify (\s -> s{clientIndex = Just banId}) |
364 |
366 clHost <- client's host |
365 processAction (clID, serverInfo, rnc) (KickRoomClient kickID) = do |
367 currentTime <- io $ getCurrentTime |
366 writeChan (sendChan $ clients ! kickID) ["KICKED"] |
368 let msg = "Ban for " `B.append` (B.pack . show $ seconds) `B.append` "seconds (" `B.append` msg` B.append` ")" |
367 liftM2 replaceID (return clID) (processAction (kickID, serverInfo, rnc) $ RoomRemoveThisClient "kicked") |
369 processAction $ ModifyServerInfo (\s -> s{lastLogins = (clHost, (addUTCTime seconds $ currentTime, msg)) : lastLogins s}) |
368 |
370 |
369 -} |
371 |
370 |
372 processAction (KickRoomClient kickId) = do |
371 processAction (AddClient client) = do |
373 modify (\s -> s{clientIndex = Just kickId}) |
|
374 ch <- client's sendChan |
|
375 mapM_ processAction [AnswerClients [ch] ["KICKED"], MoveToLobby "kicked"] |
|
376 |
|
377 |
|
378 processAction (AddClient cl) = do |
372 rnc <- gets roomsClients |
379 rnc <- gets roomsClients |
373 si <- gets serverInfo |
380 si <- gets serverInfo |
374 io $ do |
381 newClId <- io $ do |
375 ci <- addClient rnc client |
382 ci <- addClient rnc cl |
376 t <- forkIO $ clientRecvLoop (clientSocket client) (coreChan si) ci |
383 t <- forkIO $ clientRecvLoop (clientSocket cl) (coreChan si) ci |
377 forkIO $ clientSendLoop (clientSocket client) t (coreChan si) (sendChan client) ci |
384 forkIO $ clientSendLoop (clientSocket cl) t (coreChan si) (sendChan cl) ci |
378 |
385 |
379 infoM "Clients" (show ci ++ ": New client. Time: " ++ show (connectTime client)) |
386 infoM "Clients" (show ci ++ ": New client. Time: " ++ show (connectTime cl)) |
380 |
387 |
381 processAction $ AnswerClients [sendChan client] ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"] |
388 return ci |
382 {- let newLogins = takeWhile (\(_ , time) -> (connectTime client) `diffUTCTime` time <= 11) $ lastLogins serverInfo |
389 |
383 |
390 modify (\s -> s{clientIndex = Just newClId}) |
384 if False && (isJust $ host client `Prelude.lookup` newLogins) then |
391 processAction $ AnswerClients [sendChan cl] ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"] |
385 processAction (ci, serverInfo{lastLogins = newLogins}, rnc) $ ByeClient "Reconnected too fast" |
392 |
386 else |
393 si <- gets serverInfo |
387 return (ci, serverInfo) |
394 let newLogins = takeWhile (\(_ , (time, _)) -> (connectTime cl) `diffUTCTime` time <= 0) $ lastLogins si |
388 -} |
395 let info = host cl `Prelude.lookup` newLogins |
389 |
396 if isJust info then |
|
397 mapM_ processAction [ModifyServerInfo (\s -> s{lastLogins = newLogins}), ByeClient (snd . fromJust $ info)] |
|
398 else |
|
399 processAction $ ModifyServerInfo (\s -> s{lastLogins = (host cl, (addUTCTime 10 $ connectTime cl, "Reconnected too fast")) : newLogins}) |
390 |
400 |
391 |
401 |
392 processAction PingAll = do |
402 processAction PingAll = do |
393 rnc <- gets roomsClients |
403 rnc <- gets roomsClients |
394 io (allClientsM rnc) >>= mapM_ (kickTimeouted rnc) |
404 io (allClientsM rnc) >>= mapM_ (kickTimeouted rnc) |