43 | NoticeMessage Notice |
43 | NoticeMessage Notice |
44 | ByeClient B.ByteString |
44 | ByeClient B.ByteString |
45 | KickClient ClientIndex |
45 | KickClient ClientIndex |
46 | KickRoomClient ClientIndex |
46 | KickRoomClient ClientIndex |
47 | BanClient NominalDiffTime B.ByteString ClientIndex |
47 | BanClient NominalDiffTime B.ByteString ClientIndex |
|
48 | BanIP B.ByteString NominalDiffTime B.ByteString |
|
49 | BanList |
48 | ChangeMaster |
50 | ChangeMaster |
49 | RemoveClientTeams ClientIndex |
51 | RemoveClientTeams ClientIndex |
50 | ModifyClient (ClientInfo -> ClientInfo) |
52 | ModifyClient (ClientInfo -> ClientInfo) |
51 | ModifyClient2 ClientIndex (ClientInfo -> ClientInfo) |
53 | ModifyClient2 ClientIndex (ClientInfo -> ClientInfo) |
52 | ModifyRoom (RoomInfo -> RoomInfo) |
54 | ModifyRoom (RoomInfo -> RoomInfo) |
391 |
393 |
392 processAction (BanClient seconds reason banId) = do |
394 processAction (BanClient seconds reason banId) = do |
393 modify (\s -> s{clientIndex = Just banId}) |
395 modify (\s -> s{clientIndex = Just banId}) |
394 clHost <- client's host |
396 clHost <- client's host |
395 currentTime <- io getCurrentTime |
397 currentTime <- io getCurrentTime |
396 let msg = B.concat ["Ban for ", B.pack . show $ seconds, "seconds (", reason, ")"] |
398 let msg = B.concat ["Ban for ", B.pack . show $ seconds, " (", reason, ")"] |
397 mapM_ processAction [ |
399 mapM_ processAction [ |
398 AddIP2Bans clHost msg (addUTCTime seconds currentTime) |
400 AddIP2Bans clHost msg (addUTCTime seconds currentTime) |
399 , KickClient banId |
401 , KickClient banId |
400 ] |
402 ] |
|
403 |
|
404 processAction (BanIP ip seconds reason) = do |
|
405 currentTime <- io getCurrentTime |
|
406 let msg = B.concat ["Ban for ", B.pack . show $ seconds, " (", reason, ")"] |
|
407 processAction $ |
|
408 AddIP2Bans ip msg (addUTCTime seconds currentTime) |
|
409 |
|
410 processAction BanList = do |
|
411 ch <- client's sendChan |
|
412 bans <- gets (bans . serverInfo) |
|
413 processAction $ |
|
414 AnswerClients [ch] ["BANLIST", B.pack $ show bans] |
|
415 |
401 |
416 |
402 |
417 |
403 processAction (KickRoomClient kickId) = do |
418 processAction (KickRoomClient kickId) = do |
404 modify (\s -> s{clientIndex = Just kickId}) |
419 modify (\s -> s{clientIndex = Just kickId}) |
405 ch <- client's sendChan |
420 ch <- client's sendChan |
440 clNick <- client's nick |
455 clNick <- client's nick |
441 clHost <- client's host |
456 clHost <- client's host |
442 si <- gets serverInfo |
457 si <- gets serverInfo |
443 let validBans = filter (checkNotExpired clTime) $ bans si |
458 let validBans = filter (checkNotExpired clTime) $ bans si |
444 let ban = L.find (checkBan clHost clNick) $ validBans |
459 let ban = L.find (checkBan clHost clNick) $ validBans |
445 when (isJust ban) $ |
460 mapM_ processAction $ |
446 mapM_ processAction [ |
|
447 ModifyServerInfo (\s -> s{bans = validBans}) |
461 ModifyServerInfo (\s -> s{bans = validBans}) |
448 , ByeClient (getBanReason $ fromJust ban) |
462 : [ByeClient (getBanReason $ fromJust ban) | isJust ban] |
449 ] |
|
450 where |
463 where |
451 checkNotExpired testTime (BanByIP _ _ time) = testTime `diffUTCTime` time <= 0 |
464 checkNotExpired testTime (BanByIP _ _ time) = testTime `diffUTCTime` time <= 0 |
452 checkNotExpired testTime (BanByNick _ _ time) = testTime `diffUTCTime` time <= 0 |
465 checkNotExpired testTime (BanByNick _ _ time) = testTime `diffUTCTime` time <= 0 |
453 checkBan ip _ (BanByIP bip _ _) = bip == ip |
466 checkBan ip _ (BanByIP bip _ _) = bip `B.isPrefixOf` ip |
454 checkBan _ n (BanByNick bn _ _) = bn == n |
467 checkBan _ n (BanByNick bn _ _) = bn == n |
455 getBanReason (BanByIP _ msg _) = msg |
468 getBanReason (BanByIP _ msg _) = msg |
456 getBanReason (BanByNick _ msg _) = msg |
469 getBanReason (BanByNick _ msg _) = msg |
457 |
470 |
458 processAction PingAll = do |
471 processAction PingAll = do |