50 | ByeClient B.ByteString |
50 | ByeClient B.ByteString |
51 | KickClient ClientIndex |
51 | KickClient ClientIndex |
52 | KickRoomClient ClientIndex |
52 | KickRoomClient ClientIndex |
53 | BanClient NominalDiffTime B.ByteString ClientIndex |
53 | BanClient NominalDiffTime B.ByteString ClientIndex |
54 | BanIP B.ByteString NominalDiffTime B.ByteString |
54 | BanIP B.ByteString NominalDiffTime B.ByteString |
|
55 | BanNick B.ByteString NominalDiffTime B.ByteString |
55 | BanList |
56 | BanList |
56 | Unban B.ByteString |
57 | Unban B.ByteString |
57 | ChangeMaster |
58 | ChangeMaster (Maybe ClientIndex) |
58 | RemoveClientTeams ClientIndex |
59 | RemoveClientTeams ClientIndex |
59 | ModifyClient (ClientInfo -> ClientInfo) |
60 | ModifyClient (ClientInfo -> ClientInfo) |
60 | ModifyClient2 ClientIndex (ClientInfo -> ClientInfo) |
61 | ModifyClient2 ClientIndex (ClientInfo -> ClientInfo) |
61 | ModifyRoomClients (ClientInfo -> ClientInfo) |
62 | ModifyRoomClients (ClientInfo -> ClientInfo) |
62 | ModifyRoom (RoomInfo -> RoomInfo) |
63 | ModifyRoom (RoomInfo -> RoomInfo) |
152 io $ |
153 io $ |
153 infoM "Clients" (show ci ++ " quits: " ++ B.unpack msg) |
154 infoM "Clients" (show ci ++ " quits: " ++ B.unpack msg) |
154 |
155 |
155 when loggedIn $ processAction $ AnswerClients clientsChans ["LOBBY:LEFT", clNick, msg] |
156 when loggedIn $ processAction $ AnswerClients clientsChans ["LOBBY:LEFT", clNick, msg] |
156 |
157 |
157 mapM processAction |
158 mapM_ processAction |
158 [ |
159 [ |
159 AnswerClients [chan] ["BYE", msg] |
160 AnswerClients [chan] ["BYE", msg] |
160 , ModifyClient (\c -> c{nick = "", logonPassed = False}) -- this will effectively hide client from others while he isn't deleted from list |
161 , ModifyClient (\c -> c{nick = "", logonPassed = False}) -- this will effectively hide client from others while he isn't deleted from list |
161 ] |
162 ] |
162 |
163 |
232 clNick <- client's nick |
233 clNick <- client's nick |
233 chans <- othersChans |
234 chans <- othersChans |
234 |
235 |
235 if master then |
236 if master then |
236 if playersNum > 1 then |
237 if playersNum > 1 then |
237 mapM_ processAction [ChangeMaster, NoticeMessage AdminLeft, RemoveClientTeams ci, AnswerClients chans ["LEFT", clNick, msg]] |
238 mapM_ processAction [ChangeMaster Nothing, NoticeMessage AdminLeft, RemoveClientTeams ci, AnswerClients chans ["LEFT", clNick, msg]] |
238 else |
239 else |
239 processAction RemoveRoom |
240 processAction RemoveRoom |
240 else |
241 else |
241 mapM_ processAction [RemoveClientTeams ci, AnswerClients chans ["LEFT", clNick, msg]] |
242 mapM_ processAction [RemoveClientTeams ci, AnswerClients chans ["LEFT", clNick, msg]] |
242 |
243 |
248 readyPlayers = if ready then readyPlayers r - 1 else readyPlayers r |
249 readyPlayers = if ready then readyPlayers r - 1 else readyPlayers r |
249 }) ri |
250 }) ri |
250 moveClientToLobby rnc ci |
251 moveClientToLobby rnc ci |
251 |
252 |
252 |
253 |
253 processAction ChangeMaster = do |
254 processAction (ChangeMaster delegateId)= do |
254 (Just ci) <- gets clientIndex |
255 (Just ci) <- gets clientIndex |
255 proto <- client's clientProto |
256 proto <- client's clientProto |
256 ri <- clientRoomA |
257 ri <- clientRoomA |
257 rnc <- gets roomsClients |
258 rnc <- gets roomsClients |
258 newMasterId <- liftM (last . filter (/= ci)) . io $ roomClientsIndicesM rnc ri |
259 newMasterId <- liftM (\ids -> fromMaybe (last . filter (/= ci) $ ids) delegateId) . io $ roomClientsIndicesM rnc ri |
259 newMaster <- io $ client'sM rnc id newMasterId |
260 newMaster <- io $ client'sM rnc id newMasterId |
260 oldRoomName <- io $ room'sM rnc name ri |
261 oldRoomName <- io $ room'sM rnc name ri |
261 oldMaster <- client's nick |
262 oldMaster <- client's nick |
|
263 kicked <- client's isKickedFromServer |
262 thisRoomChans <- liftM (map sendChan) $ roomClientsS ri |
264 thisRoomChans <- liftM (map sendChan) $ roomClientsS ri |
263 let newRoomName = if proto < 42 then nick newMaster else oldRoomName |
265 let newRoomName = if (proto < 42) || kicked then nick newMaster else oldRoomName |
264 mapM_ processAction [ |
266 mapM_ processAction [ |
265 ModifyRoom (\r -> r{masterID = newMasterId |
267 ModifyRoom (\r -> r{masterID = newMasterId |
266 , name = newRoomName |
268 , name = newRoomName |
267 , isRestrictedJoins = False |
269 , isRestrictedJoins = False |
268 , isRestrictedTeams = False |
270 , isRestrictedTeams = False |
|
271 , isRegisteredOnly = False |
269 , readyPlayers = if isReady newMaster then readyPlayers r else readyPlayers r + 1}) |
272 , readyPlayers = if isReady newMaster then readyPlayers r else readyPlayers r + 1}) |
270 , ModifyClient2 newMasterId (\c -> c{isMaster = True, isReady = True}) |
273 , ModifyClient2 newMasterId (\c -> c{isMaster = True, isReady = True}) |
271 , AnswerClients [sendChan newMaster] ["ROOM_CONTROL_ACCESS", "1"] |
274 , AnswerClients [sendChan newMaster] ["ROOM_CONTROL_ACCESS", "1"] |
272 , AnswerClients thisRoomChans ["WARNING", "New room admin is " `B.append` nick newMaster] |
|
273 , AnswerClients thisRoomChans ["CLIENT_FLAGS", "-h", oldMaster] |
275 , AnswerClients thisRoomChans ["CLIENT_FLAGS", "-h", oldMaster] |
274 , AnswerClients thisRoomChans ["CLIENT_FLAGS", "+hr", nick newMaster] |
276 , AnswerClients thisRoomChans ["CLIENT_FLAGS", "+hr", nick newMaster] |
275 ] |
277 ] |
276 |
278 |
277 newRoom' <- io $ room'sM rnc id ri |
279 newRoom' <- io $ room'sM rnc id ri |
420 p <- client's clientProto |
423 p <- client's clientProto |
421 uid <- client's clUID |
424 uid <- client's clUID |
422 haveSameNick <- liftM (not . null . tail . filter (\c -> caseInsensitiveCompare (nick c) n)) allClientsS |
425 haveSameNick <- liftM (not . null . tail . filter (\c -> caseInsensitiveCompare (nick c) n)) allClientsS |
423 if haveSameNick then |
426 if haveSameNick then |
424 if p < 38 then |
427 if p < 38 then |
425 mapM_ processAction [ByeClient "Nickname is already in use", removeNick] |
428 processAction $ ByeClient "Nickname is already in use" |
426 else |
429 else |
427 mapM_ processAction [NoticeMessage NickAlreadyInUse, removeNick] |
430 processAction $ NoticeMessage NickAlreadyInUse |
428 else |
431 else |
429 do |
432 do |
430 db <- gets (dbQueries . serverInfo) |
433 db <- gets (dbQueries . serverInfo) |
431 io $ writeChan db $ CheckAccount ci (hashUnique uid) n h |
434 io $ writeChan db $ CheckAccount ci (hashUnique uid) n h |
432 return () |
435 return () |
433 where |
|
434 removeNick = ModifyClient (\c -> c{nick = ""}) |
|
435 |
|
436 |
436 |
437 processAction ClearAccountsCache = do |
437 processAction ClearAccountsCache = do |
438 dbq <- gets (dbQueries . serverInfo) |
438 dbq <- gets (dbQueries . serverInfo) |
439 io $ writeChan dbq ClearCache |
439 io $ writeChan dbq ClearCache |
440 return () |
440 return () |
441 |
441 |
442 |
442 |
443 processAction (ProcessAccountInfo info) = |
443 processAction (ProcessAccountInfo info) = do |
444 case info of |
444 case info of |
445 HasAccount passwd isAdmin -> do |
445 HasAccount passwd isAdmin -> do |
446 chan <- client's sendChan |
446 b <- isBanned |
447 mapM_ processAction [AnswerClients [chan] ["ASKPASSWORD"], ModifyClient (\c -> c{webPassword = passwd, isAdministrator = isAdmin})] |
447 when (not b) $ do |
448 Guest -> |
448 chan <- client's sendChan |
449 processAction JoinLobby |
449 mapM_ processAction [AnswerClients [chan] ["ASKPASSWORD"], ModifyClient (\c -> c{webPassword = passwd, isAdministrator = isAdmin})] |
|
450 Guest -> do |
|
451 b <- isBanned |
|
452 when (not b) $ |
|
453 processAction JoinLobby |
450 Admin -> do |
454 Admin -> do |
451 mapM_ processAction [ModifyClient (\cl -> cl{isAdministrator = True}), JoinLobby] |
455 mapM_ processAction [ModifyClient (\cl -> cl{isAdministrator = True}), JoinLobby] |
452 chan <- client's sendChan |
456 chan <- client's sendChan |
453 processAction $ AnswerClients [chan] ["ADMIN_ACCESS"] |
457 processAction $ AnswerClients [chan] ["ADMIN_ACCESS"] |
|
458 where |
|
459 isBanned = do |
|
460 processAction $ CheckBanned False |
|
461 liftM B.null $ client's nick |
454 |
462 |
455 |
463 |
456 processAction JoinLobby = do |
464 processAction JoinLobby = do |
457 chan <- client's sendChan |
465 chan <- client's sendChan |
458 clientNick <- client's nick |
466 clientNick <- client's nick |
477 processAction (KickClient kickId) = do |
485 processAction (KickClient kickId) = do |
478 modify (\s -> s{clientIndex = Just kickId}) |
486 modify (\s -> s{clientIndex = Just kickId}) |
479 clHost <- client's host |
487 clHost <- client's host |
480 currentTime <- io getCurrentTime |
488 currentTime <- io getCurrentTime |
481 mapM_ processAction [ |
489 mapM_ processAction [ |
482 AddIP2Bans clHost "60 seconds cooldown after kick" (addUTCTime 60 currentTime), |
490 AddIP2Bans clHost "60 seconds cooldown after kick" (addUTCTime 60 currentTime) |
483 ByeClient "Kicked" |
491 , ModifyClient (\c -> c{isKickedFromServer = True}) |
|
492 , ByeClient "Kicked" |
484 ] |
493 ] |
485 |
494 |
486 |
495 |
487 processAction (BanClient seconds reason banId) = do |
496 processAction (BanClient seconds reason banId) = do |
488 modify (\s -> s{clientIndex = Just banId}) |
497 modify (\s -> s{clientIndex = Just banId}) |
492 mapM_ processAction [ |
501 mapM_ processAction [ |
493 AddIP2Bans clHost msg (addUTCTime seconds currentTime) |
502 AddIP2Bans clHost msg (addUTCTime seconds currentTime) |
494 , KickClient banId |
503 , KickClient banId |
495 ] |
504 ] |
496 |
505 |
|
506 |
497 processAction (BanIP ip seconds reason) = do |
507 processAction (BanIP ip seconds reason) = do |
498 currentTime <- io getCurrentTime |
508 currentTime <- io getCurrentTime |
499 let msg = B.concat ["Ban for ", B.pack . show $ seconds, " (", reason, ")"] |
509 let msg = B.concat ["Ban for ", B.pack . show $ seconds, " (", reason, ")"] |
500 processAction $ |
510 processAction $ |
501 AddIP2Bans ip msg (addUTCTime seconds currentTime) |
511 AddIP2Bans ip msg (addUTCTime seconds currentTime) |
502 |
512 |
|
513 |
|
514 processAction (BanNick n seconds reason) = do |
|
515 currentTime <- io getCurrentTime |
|
516 let msg = |
|
517 if seconds > 60 * 60 * 24 * 365 then |
|
518 B.concat ["Permanent ban (", reason, ")"] |
|
519 else |
|
520 B.concat ["Ban for ", B.pack . show $ seconds, " (", reason, ")"] |
|
521 processAction $ |
|
522 AddNick2Bans n msg (addUTCTime seconds currentTime) |
|
523 |
|
524 |
503 processAction BanList = do |
525 processAction BanList = do |
|
526 time <- io $ getCurrentTime |
504 ch <- client's sendChan |
527 ch <- client's sendChan |
505 b <- gets (B.pack . unlines . map show . bans . serverInfo) |
528 b <- gets (B.intercalate "\n" . concatMap (ban2Str time) . bans . serverInfo) |
506 processAction $ |
529 processAction $ |
507 AnswerClients [ch] ["BANLIST", b] |
530 AnswerClients [ch] ["BANLIST", b] |
|
531 where |
|
532 ban2Str time (BanByIP b r t) = ["I", b, r, B.pack . show $ t `diffUTCTime` time] |
|
533 ban2Str time (BanByNick b r t) = ["N", b, r, B.pack . show $ t `diffUTCTime` time] |
|
534 |
508 |
535 |
509 processAction (Unban entry) = do |
536 processAction (Unban entry) = do |
510 processAction $ ModifyServerInfo (\s -> s{bans = filter f $ bans s}) |
537 processAction $ ModifyServerInfo (\s -> s{bans = filter (not . f) $ bans s}) |
511 where |
538 where |
512 f (BanByIP bip _ _) = bip == entry |
539 f (BanByIP bip _ _) = bip == entry |
513 f (BanByNick bn _ _) = bn == entry |
540 f (BanByNick bn _ _) = bn == entry |
|
541 |
514 |
542 |
515 processAction (KickRoomClient kickId) = do |
543 processAction (KickRoomClient kickId) = do |
516 modify (\s -> s{clientIndex = Just kickId}) |
544 modify (\s -> s{clientIndex = Just kickId}) |
517 ch <- client's sendChan |
545 ch <- client's sendChan |
518 mapM_ processAction [AnswerClients [ch] ["KICKED"], MoveToLobby "kicked"] |
546 mapM_ processAction [AnswerClients [ch] ["KICKED"], MoveToLobby "kicked"] |
545 (Just ci) <- gets clientIndex |
573 (Just ci) <- gets clientIndex |
546 rc <- gets removedClients |
574 rc <- gets removedClients |
547 when (not $ ci `Set.member` rc) |
575 when (not $ ci `Set.member` rc) |
548 $ processAction $ ModifyServerInfo (\s -> s{bans = BanByIP ip reason expiring : bans s}) |
576 $ processAction $ ModifyServerInfo (\s -> s{bans = BanByIP ip reason expiring : bans s}) |
549 |
577 |
550 processAction CheckBanned = do |
578 processAction (CheckBanned byIP) = do |
551 clTime <- client's connectTime |
579 clTime <- client's connectTime |
552 clNick <- client's nick |
580 clNick <- client's nick |
553 clHost <- client's host |
581 clHost <- client's host |
554 si <- gets serverInfo |
582 si <- gets serverInfo |
555 let validBans = filter (checkNotExpired clTime) $ bans si |
583 let validBans = filter (checkNotExpired clTime) $ bans si |
556 let ban = L.find (checkBan clHost clNick) $ validBans |
584 let ban = L.find (checkBan byIP clHost clNick) $ validBans |
557 mapM_ processAction $ |
585 mapM_ processAction $ |
558 ModifyServerInfo (\s -> s{bans = validBans}) |
586 ModifyServerInfo (\s -> s{bans = validBans}) |
559 : [ByeClient (getBanReason $ fromJust ban) | isJust ban] |
587 : [ByeClient (getBanReason $ fromJust ban) | isJust ban] |
560 where |
588 where |
561 checkNotExpired testTime (BanByIP _ _ time) = testTime `diffUTCTime` time <= 0 |
589 checkNotExpired testTime (BanByIP _ _ time) = testTime `diffUTCTime` time <= 0 |
562 checkNotExpired testTime (BanByNick _ _ time) = testTime `diffUTCTime` time <= 0 |
590 checkNotExpired testTime (BanByNick _ _ time) = testTime `diffUTCTime` time <= 0 |
563 checkBan ip _ (BanByIP bip _ _) = bip `B.isPrefixOf` ip |
591 checkBan True ip _ (BanByIP bip _ _) = bip `B.isPrefixOf` ip |
564 checkBan _ n (BanByNick bn _ _) = bn == n |
592 checkBan False _ n (BanByNick bn _ _) = caseInsensitiveCompare bn n |
|
593 checkBan _ _ _ _ = False |
565 getBanReason (BanByIP _ msg _) = msg |
594 getBanReason (BanByIP _ msg _) = msg |
566 getBanReason (BanByNick _ msg _) = msg |
595 getBanReason (BanByNick _ msg _) = msg |
567 |
596 |
568 processAction PingAll = do |
597 processAction PingAll = do |
569 rnc <- gets roomsClients |
598 rnc <- gets roomsClients |