2011-02-13 06:07:02 +01:00
# File: BanTracker.pm
# Author: pragma_
#
# Purpose: Populates and maintains channel banlists by checking mode +b on
# joining channels and by tracking modes +b and -b in channels.
#
# Does NOT do banning or unbanning.
2017-03-05 22:33:31 +01:00
# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
2011-02-13 06:07:02 +01:00
package PBot::BanTracker ;
use warnings ;
use strict ;
use Time::HiRes qw/gettimeofday/ ;
use Time::Duration ;
use Data::Dumper ;
2018-02-28 20:13:56 +01:00
$ Data:: Dumper:: Sortkeys = 1 ;
2011-02-13 06:07:02 +01:00
use Carp ( ) ;
sub new {
if ( ref ( $ _ [ 1 ] ) eq 'HASH' ) {
Carp:: croak ( "Options to BanTracker should be key/value pairs, not hash reference" ) ;
}
my ( $ class , % conf ) = @ _ ;
my $ self = bless { } , $ class ;
$ self - > initialize ( % conf ) ;
return $ self ;
}
sub initialize {
my ( $ self , % conf ) = @ _ ;
2014-11-01 01:15:21 +01:00
$ self - > { pbot } = delete $ conf { pbot } // Carp:: croak ( "Missing pbot reference to BanTracker" ) ;
2011-02-13 06:07:02 +01:00
$ self - > { banlist } = { } ;
2014-05-23 07:03:54 +02:00
$ self - > { pbot } - > { registry } - > add_default ( 'text' , 'bantracker' , 'chanserv_ban_timeout' , '604800' ) ;
2015-05-27 19:46:30 +02:00
$ self - > { pbot } - > { registry } - > add_default ( 'text' , 'bantracker' , 'mute_timeout' , '604800' ) ;
2014-12-27 06:20:21 +01:00
$ self - > { pbot } - > { registry } - > add_default ( 'text' , 'bantracker' , 'debug' , '0' ) ;
2014-05-23 07:03:54 +02:00
2014-11-01 01:15:21 +01:00
$ self - > { pbot } - > { commands } - > register ( sub { $ self - > dumpbans ( @ _ ) } , "dumpbans" , 60 ) ;
$ self - > { pbot } - > { event_dispatcher } - > register_handler ( 'irc.endofnames' , sub { $ self - > get_banlist ( @ _ ) } ) ;
$ self - > { pbot } - > { event_dispatcher } - > register_handler ( 'irc.banlist' , sub { $ self - > on_banlist_entry ( @ _ ) } ) ;
$ self - > { pbot } - > { event_dispatcher } - > register_handler ( 'irc.quietlist' , sub { $ self - > on_quietlist_entry ( @ _ ) } ) ;
2011-02-13 06:07:02 +01:00
}
sub dumpbans {
my ( $ self , $ from , $ nick , $ user , $ host , $ arguments ) = @ _ ;
my $ bans = Dumper ( $ self - > { banlist } ) ;
return $ bans ;
}
sub get_banlist {
2014-11-01 01:15:21 +01:00
my ( $ self , $ event_type , $ event ) = @ _ ;
my $ channel = lc $ event - > { event } - > { args } [ 1 ] ;
2011-02-13 06:07:02 +01:00
2018-02-28 20:13:56 +01:00
return 0 if not $ self - > { pbot } - > { chanops } - > can_gain_ops ( $ channel ) ;
2011-02-13 06:07:02 +01:00
delete $ self - > { banlist } - > { $ channel } ;
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { logger } - > log ( "Retrieving banlist for $channel.\n" ) ;
2018-02-28 20:13:56 +01:00
$ event - > { conn } - > sl ( "mode $channel +bq" ) ;
2014-11-01 01:15:21 +01:00
return 0 ;
}
sub on_banlist_entry {
my ( $ self , $ event_type , $ event ) = @ _ ;
my $ channel = lc $ event - > { event } - > { args } [ 1 ] ;
my $ target = lc $ event - > { event } - > { args } [ 2 ] ;
my $ source = lc $ event - > { event } - > { args } [ 3 ] ;
my $ timestamp = $ event - > { event } - > { args } [ 4 ] ;
my $ ago = ago ( gettimeofday - $ timestamp ) ;
$ self - > { pbot } - > { logger } - > log ( "ban-tracker: [banlist entry] $channel: $target banned by $source $ago.\n" ) ;
$ self - > { banlist } - > { $ channel } - > { '+b' } - > { $ target } = [ $ source , $ timestamp ] ;
2017-05-21 11:20:44 +02:00
if ( $ target =~ m/^\*!\*@/ or $ target =~ m/^\*!.*\@gateway\/web/i ) {
my $ timeout = 60 * 60 * 24 * 7 ;
if ( $ target =~ m/\// and $ target !~ m/\@gateway/ ) {
$ timeout = 0 ; # permanent bans for cloaks that aren't gateway
}
if ( $ timeout && $ self - > { pbot } - > { chanops } - > can_gain_ops ( $ channel ) ) {
if ( not exists $ self - > { pbot } - > { chanops } - > { unban_timeout } - > hash - > { $ channel } - > { $ target } ) {
$ self - > { pbot } - > { logger } - > log ( "Temp ban for $target in $channel.\n" ) ;
$ self - > { pbot } - > { chanops } - > { unban_timeout } - > hash - > { $ channel } - > { $ target } { timeout } = gettimeofday + $ timeout ;
$ self - > { pbot } - > { chanops } - > { unban_timeout } - > save ;
}
}
}
2014-11-01 01:15:21 +01:00
return 0 ;
}
sub on_quietlist_entry {
my ( $ self , $ event_type , $ event ) = @ _ ;
my $ channel = lc $ event - > { event } - > { args } [ 1 ] ;
my $ target = lc $ event - > { event } - > { args } [ 3 ] ;
my $ source = lc $ event - > { event } - > { args } [ 4 ] ;
my $ timestamp = $ event - > { event } - > { args } [ 5 ] ;
my $ ago = ago ( gettimeofday - $ timestamp ) ;
$ self - > { pbot } - > { logger } - > log ( "ban-tracker: [quietlist entry] $channel: $target quieted by $source $ago.\n" ) ;
$ self - > { banlist } - > { $ channel } - > { '+q' } - > { $ target } = [ $ source , $ timestamp ] ;
return 0 ;
2011-02-13 10:05:48 +01:00
}
sub get_baninfo {
2013-07-28 12:31:12 +02:00
my ( $ self , $ mask , $ channel , $ account ) = @ _ ;
my ( $ bans , $ ban_account ) ;
2017-04-11 04:13:56 +02:00
$ account = undef if not length $ account ;
2013-07-30 15:12:21 +02:00
$ account = lc $ account if defined $ account ;
2014-12-27 06:20:21 +01:00
if ( $ self - > { pbot } - > { registry } - > get_value ( 'bantracker' , 'debug' ) ) {
$ self - > { pbot } - > { logger } - > log ( "[get-baninfo] Getting baninfo for $mask in $channel using account " . ( defined $ account ? $ account : "[undefined]" ) . "\n" ) ;
}
2013-08-03 19:26:49 +02:00
2015-06-14 01:08:57 +02:00
my ( $ nick , $ user , $ host ) = $ mask =~ m/([^!]+)!([^@]+)@(.*)/ ;
2016-02-25 09:46:55 +01:00
foreach my $ mode ( keys % { $ self - > { banlist } - > { $ channel } } ) {
foreach my $ banmask ( keys % { $ self - > { banlist } - > { $ channel } - > { $ mode } } ) {
2013-07-28 12:31:12 +02:00
if ( $ banmask =~ m/^\$a:(.*)/ ) {
$ ban_account = lc $ 1 ;
} else {
$ ban_account = "" ;
}
2013-09-13 23:48:19 +02:00
my $ banmask_key = $ banmask ;
$ banmask = quotemeta $ banmask ;
$ banmask =~ s/\\\*/.*?/g ;
$ banmask =~ s/\\\?/./g ;
2015-06-14 01:08:57 +02:00
my $ banned ;
$ banned = 1 if defined $ account and $ account eq $ ban_account ;
$ banned = 1 if $ mask =~ m/^$banmask$/i ;
if ( $ banmask_key =~ m {\@gateway/web/irccloud.com} and $ host =~ m {^gateway/web/irccloud.com} ) {
my ( $ bannick , $ banuser , $ banhost ) = $ banmask_key =~ m/([^!]+)!([^@]+)@(.*)/ ;
if ( lc $ user eq lc $ banuser ) {
$ banned = 1 ;
}
}
if ( $ banned ) {
2013-07-28 12:31:12 +02:00
if ( not defined $ bans ) {
$ bans = [] ;
2011-12-15 07:18:10 +01:00
}
2013-07-28 12:31:12 +02:00
my $ baninfo = { } ;
$ baninfo - > { banmask } = $ banmask_key ;
$ baninfo - > { channel } = $ channel ;
2016-02-25 09:46:55 +01:00
$ baninfo - > { owner } = $ self - > { banlist } - > { $ channel } - > { $ mode } - > { $ banmask_key } - > [ 0 ] ;
$ baninfo - > { when } = $ self - > { banlist } - > { $ channel } - > { $ mode } - > { $ banmask_key } - > [ 1 ] ;
2013-07-28 12:31:12 +02:00
$ baninfo - > { type } = $ mode ;
2016-09-02 11:09:43 +02:00
#$self->{pbot}->{logger}->log("get-baninfo: dump: " . Dumper($baninfo) . "\n");
2018-08-01 02:21:37 +02:00
#$self->{pbot}->{logger}->log("get-baninfo: $baninfo->{banmask} $baninfo->{type} in $baninfo->{channel} by $baninfo->{owner} on $baninfo->{when}\n");
2013-07-28 12:31:12 +02:00
push @$ bans , $ baninfo ;
2011-02-13 10:05:48 +01:00
}
}
}
2013-07-28 12:31:12 +02:00
return $ bans ;
2011-02-13 06:07:02 +01:00
}
2018-08-06 07:42:29 +02:00
sub is_banned {
my ( $ self , $ nick , $ user , $ host , $ channel ) = @ _ ;
my $ message_account = $ self - > { pbot } - > { messagehistory } - > { database } - > get_message_account ( $ nick , $ user , $ host ) ;
my @ nickserv_accounts = $ self - > { pbot } - > { messagehistory } - > { database } - > get_nickserv_accounts ( $ message_account ) ;
push @ nickserv_accounts , undef ;
my $ banned = undef ;
foreach my $ nickserv_account ( @ nickserv_accounts ) {
my $ baninfos = $ self - > get_baninfo ( "$nick!$user\@$host" , $ channel , $ nickserv_account ) ;
if ( defined $ baninfos ) {
foreach my $ baninfo ( @$ baninfos ) {
if ( $ self - > { pbot } - > { antiflood } - > whitelisted ( $ baninfo - > { channel } , $ baninfo - > { banmask } , 'ban' ) || $ self - > { pbot } - > { antiflood } - > whitelisted ( $ baninfo - > { channel } , "$nick!$user\@$host" , 'user' ) ) {
$ self - > { pbot } - > { logger } - > log ( "[BanTracker] is_banned: $nick!$user\@$host banned as $baninfo->{banmask} in $baninfo->{channel}, but allowed through whitelist\n" ) ;
} else {
if ( $ channel eq lc $ baninfo - > { channel } ) {
my $ mode = $ baninfo - > { type } eq "+b" ? "banned" : "quieted" ;
$ self - > { pbot } - > { logger } - > log ( "[BanTracker] is_banned: $nick!$user\@$host $mode as $baninfo->{banmask} in $baninfo->{channel} by $baninfo->{owner}\n" ) ;
$ banned = $ baninfo ;
last ;
}
}
}
}
}
return $ banned ;
}
2011-02-13 06:07:02 +01:00
sub track_mode {
my $ self = shift ;
my ( $ source , $ mode , $ target , $ channel ) = @ _ ;
2016-07-01 21:56:25 +02:00
$ mode = lc $ mode ;
$ target = lc $ target ;
$ channel = lc $ channel ;
2011-02-13 10:05:48 +01:00
if ( $ mode eq "+b" or $ mode eq "+q" ) {
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { logger } - > log ( "ban-tracker: $target " . ( $ mode eq '+b' ? 'banned' : 'quieted' ) . " by $source in $channel.\n" ) ;
2011-12-17 12:43:21 +01:00
$ self - > { banlist } - > { $ channel } - > { $ mode } - > { $ target } = [ $ source , gettimeofday ] ;
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { antiflood } - > devalidate_accounts ( $ target , $ channel ) ;
2011-02-13 06:07:02 +01:00
}
2011-02-13 10:05:48 +01:00
elsif ( $ mode eq "-b" or $ mode eq "-q" ) {
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { logger } - > log ( "ban-tracker: $target " . ( $ mode eq '-b' ? 'unbanned' : 'unquieted' ) . " by $source in $channel.\n" ) ;
2011-12-17 12:43:21 +01:00
delete $ self - > { banlist } - > { $ channel } - > { $ mode eq "-b" ? "+b" : "+q" } - > { $ target } ;
2013-11-17 18:06:54 +01:00
if ( $ mode eq "-b" ) {
2014-05-18 22:09:05 +02:00
if ( $ self - > { pbot } - > { chanops } - > { unban_timeout } - > find_index ( $ channel , $ target ) ) {
$ self - > { pbot } - > { chanops } - > { unban_timeout } - > remove ( $ channel , $ target ) ;
} elsif ( $ self - > { pbot } - > { chanops } - > { unban_timeout } - > find_index ( $ channel , "$target\$##stop_join_flood" ) ) {
2013-11-17 18:06:54 +01:00
# freenode strips channel forwards from unban result if no ban exists with a channel forward
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { chanops } - > { unban_timeout } - > remove ( $ channel , "$target\$##stop_join_flood" ) ;
2013-11-17 18:06:54 +01:00
}
2013-07-24 14:35:40 +02:00
}
2015-05-27 20:26:16 +02:00
elsif ( $ mode eq "-q" ) {
if ( $ self - > { pbot } - > { chanops } - > { unmute_timeout } - > find_index ( $ channel , $ target ) ) {
$ self - > { pbot } - > { chanops } - > { unmute_timeout } - > remove ( $ channel , $ target ) ;
}
}
2011-02-13 06:07:02 +01:00
} else {
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { logger } - > log ( "BanTracker: Unknown mode '$mode'\n" ) ;
2011-02-13 06:07:02 +01:00
}
}
1 ;