#!/usr/bin/perl
#use strict;
use Irssi;
use Irssi::Irc;

$VERSION = 20030830;
%IRSSI = (
	authors	=> 'Michał Mirosław',
	contact	=> 'mirqus@lagoon.freebsd.lublin.pl',
	name	=> 'rereqmqm',
	description => 'Applies different ban types to people based on their host',
	license => 'GNU GPL v2',
	url	=> undef,
	changed => '2003/08/30'
);

my $bantype_file = "$ENV{HOME}/.irssi/bantypes";

Irssi::theme_register([
	'file_error', 'Could not open file {hilight $0}: {error $1}',
	'file_loaded', 'Loaded {hilight $1} ban types from {hilight $0}',
	'file_saved', 'Saved {hilight $1} ban types to {hilight $0}',
	'invalid_hostmask', 'Invalid hostmask: $0',
	'invalid_bantype', 'Invalid ban type {hilight $0} for hostmask: $1',
	'new_bantype', 'Added ban type {hilight $1} for {hilight $0}',
	'list_head', 'Ban types: [max masked domain length = {hilight $0}]',
	'list_entry', '{hilight $0} type {hilight $1} $2',
	'chan_not_synced', 'Channel {hilight $0} not synced yet',
	'chan_no_nick', '{hilight $1} is not on {hilight $0}',
	'test_mask', 'Mask for {hilight $0}: $1',
	'ban_nick_na', 'Nick {hilight $1} is not on IRC - can\'t ban on {hilight $0}',
]);

my %auto_ban_type;
my $max_masked_domain_len = 0;

use constant TYPEFIELD_BITS => 3;
use constant TYPEFIELD_MASK => (1 << TYPEFIELD_BITS) - 1;

sub split_ban_type
{
	my ($bt) = @_;
	use integer;

	my $flags = $bt & TYPEFIELD_MASK;
	my $mask = $bt >> TYPEFIELD_BITS;
	return ($mask, $flags);
}

sub bantype_to_str
{
	my ($bt) = @_;
	use integer;

	my $str = join('.', split_ban_type($bt));
	return $str unless wantarray;

	my $v = " ";
	$v .= "IDENT:MASK " unless $bt & 1;
	$v .= "NOIDENT:MASK " unless $bt & 2;
	$v .= "DIALUP " if $bt & 4;
	chop $v;
	return ($str, $v);
}

sub add_bantype
{
	my ($host, $level, $silent) = @_;

	$host = lc $host;
	unless ($host eq '*' or $host =~ m/^(\*\.)?[a-z0-9-.]+[a-z]$/) {
		Irssi::printformat(MSGLEVEL_CLIENTERROR, 'invalid_hostmask', $host);
		return;
	}
	if ($level =~ m/^(-?[0-9]+)\.([0-7])$/) {
		use integer;
		$level = ($1 << TYPEFIELD_BITS) | ($2 & TYPEFIELD_MASK);
	} elsif ($level !~ m/^-?[0-9]+$/) {
		Irssi::printformat(MSGLEVEL_CLIENTERROR, 'invalid_bantype', $level, $host);
	}

	$auto_ban_type{$host} = $level;
	my @dom = split /\./, $host;
	$max_masked_domain_len = @dom - 1
		if $dom[0] eq '*' and @dom > $max_masked_domain_len;
	Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'new_bantype', $host, scalar bantype_to_str($level)) unless $silent;
	return 1;
}

sub load_bantypes
{
	my ($file) = @_;
	$file = $bantype_file unless defined $file;

	unless (open FH, '<'.$file) {
		Irssi::printformat(MSGLEVEL_CLIENTERROR, 'file_error', $file, $!);
		return;
	}
	my $count = 0;
	while(<FH>) {
		chomp; s/#.*$//;
		next if $_ eq '';
		my ($host, $level) = split;
		next unless defined $host and defined $level;
		add_bantype($host, $level, 1) and ++$count;
	}
	close FH;
	Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'file_loaded', $file, $count);
}

sub get_ban_type
{
	my ($host) = @_;
	return $auto_ban_type{$host} if exists $auto_ban_type{$host};

	my @dom = split(/\./, $host);
	splice @dom, 0, @dom - $max_masked_domain_len if @dom > $max_masked_domain_len;

	while (@dom > 0) {
		$host = join('.', '*', @dom);
		return $auto_ban_type{$host} if exists $auto_ban_type{$host};
		shift @dom;
	}

	return $auto_ban_type{'*'} if exists $auto_ban_type{'*'};
	return 0;
}

sub generate_ban
{
	use integer;
	my ($userhost) = @_;
	return unless $userhost =~ m/^(.*)@(.*?)$/;
	my ($user, $host) = (lc $1, lc $2);

	my ($host_cut, $flags) = split_ban_type(get_ban_type($host));

	if ($user =~ s/^[-^+~]//) {
		$user = '*' unless $flags & 2;
	} else {
		$user = '*' unless $flags & 1;
	}
	if ($user ne '*') {
		my $maxuserlen = Irssi::settings_get_int("max_ban_user_mask_chars") - 1;
		substr $user, 0, length($user) - $maxuserlen, '' if length($user) > $maxuserlen;
		$user = "*$user";
	}

	if ($host_cut != 0) {
		my @dom = split(/\./, $host);
		if ($host_cut > 0) {
			splice @dom, 0, $host_cut;
		} else {
			splice @dom, 0, @dom + $host_cut;
		}
		$host = join('.', '*', @dom);
	}
	return "*!$user\@$host";
}

sub cmd_bt
{
	my ($param, $server, $witem) = @_;
	Irssi::command_runsub("bt", $param, $server, $witem);
}

sub cmd_kickban
{
	my ($param, $server, $witem) = @_;
	return	if !$server or !$server->{connected}
		or !$witem or $witem->{type} ne "CHANNEL";

	unless ($witem->{synced}) {
		Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'chan_not_synced', $witem->{name}) unless $witem->{synced};
		return;
	}

	my $kickfirst = Irssi::settings_get_bool("kick_first_on_kickban");
	my ($nicks, $reason) = split(/\s+/, $param, 2);

	my (%banlist, %deoplist, %dehalfoplist);
	foreach(split(/\s+/, $nicks)) {
		my $nick = $witem->nick_find($_);
		unless ($nick) {
			Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'chan_no_nick', $witem->{name}, $_);
			next;
		}
		my $ban = generate_ban($nick->{host});
		push @{$banlist{$ban}}, $nick->{nick};
		unless ($kickfirst) {
			$deoplist{$ban} = [] unless exists $deoplist{$ban};
			push @{$deoplist{$ban}}, $nick->{nick} if $nick->{op};
			$dehalfoplist{$ban} = [] unless exists $dehalfoplist{$ban};
			push @{$dehalfoplist{$ban}}, $nick->{nick} if $nick->{halfop};
		}
	}
	foreach my $ban (keys %banlist) {
		my $kickcmd = "KICK " . join(',', @{$banlist{$ban}});
		$kickcmd .= " $reason" if $reason;
		my ($modes, @modeparams) = ('');
		if ($kickfirst) {
			$witem->command($kickcmd);
		} elsif (@{$deoplist{$ban}} + @{$dehalfoplist{$ban}} > 0) {
			$modes .= '-';
			$modes .= 'o' x scalar @{$deoplist{$ban}};
			push @modeparams, @{$deoplist{$ban}};
			$modes .= 'O' x scalar @{$dehalfoplist{$ban}};
			push @modeparams, @{$dehalfoplist{$ban}};
		}
		$modes .= '+b';
		push @modeparams, $ban;

		$witem->command("MODE $modes @modeparams");
		$witem->command($kickcmd) unless $kickfirst;
	}
}

sub cmd_test
{
	my ($param, $server, $witem) = @_;
	if ($param !~ m/@/) {
		return unless ref $server;
		$server->redirect_event('userhost', 1, $param, -1, undef,
			{ 'event 302' => 'redir bt test host',
			  '' => 'event empty' }
		);
		$server->send_raw("USERHOST :$param");
		return;
	}
	Irssi::printformat(MSGLEVEL_CLIENTNOTICE, 'test_mask', $param, generate_ban($param));
}

sub sig_test_userhost
{
	my ($server, $data) = @_;
	my $n;
	($n, $data) = split(' ', $data);
	$data =~ s/^\s*://;
	my ($nick, $addr) = split(/=[-+]/, $data);
	Irssi::printformat(MSGLEVEL_CLIENTNOTICE, 'test_mask', "$nick!$addr", generate_ban($addr));
}

my @ban_channel;
my @ban_nick;

sub cmd_ban
{
	my ($mask, $server, $witem) = @_;
	return	if !$server or !$server->{connected}
		or !$witem or $witem->{type} ne "CHANNEL";

	if ($mask !~ m/@/) {
		my $nick = $witem->nick_find($mask);
		if ($nick and $nick->{host}) {
			$mask = $nick->{host};
		} else {
			push @ban_channel, $witem->{name};
			push @ban_nick, $mask;
			$server->redirect_event('userhost', 1, $mask, -1, 'sig_ban_userhost_fail',
				{ 'event 302' => 'redir bt ban host',
				  '' => 'event empty' }
			);
			$server->send_raw("USERHOST :$mask");
			return;
		}
	}
	my $ban = generate_ban($mask);
	$witem->command("BAN $ban");
}

sub sig_ban_userhost_fail
{
	Irssi::printformat(MSGLEVEL_CLIENTNOTICE, 'ban_nick_na', shift(@ban_channel), shift(@ban_nick));
}

sub sig_ban_userhost
{
	my ($server, $data) = @_;
	my $n;
	($n, $data) = split(' ', $data);
	$data =~ s/^\s*://;
	my ($nick, $addr) = split(/=[-+]/, $data);
	my $chn = shift @ban_channel;
	shift @ban_nick;
	if ($addr) {
		my $ban = generate_ban($addr);
		$server->command("BAN $chn $ban");
	}
}

sub cmd_add
{
	my ($param, $server, $witem) = @_;

	my ($host, $level) = split(' ', $param);
	add_bantype($host, $level);
}

# FIXME: mask
sub cmd_list
{
	use integer;
	my ($param, $server, $witem) = @_;

	Irssi::printformat(MSGLEVEL_CLIENTNOTICE, 'list_head', $max_masked_domain_len);
	foreach(sort keys %auto_ban_type) {
		my $bt = $auto_ban_type{$_};
		Irssi::printformat(MSGLEVEL_CLIENTNOTICE, 'list_entry', $_, bantype_to_str($bt));
	}
}

sub cmd_save
{
	use integer;
	my ($param, $server, $witem) = @_;

	my $file = ($param ? $param : $bantype_file);
	unless (open FH, '>'.$file) {
		Irssi::printformat(MSGLEVEL_CLIENTERROR, 'file_error', $file, $!);
		return;
	}
	my $count = 0;
	foreach(sort keys %auto_ban_type) {
		print FH "$_ " . bantype_to_str($auto_ban_type{$_}) . "\n";
		++$count;
	}
	close FH;
	Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'file_saved', $file, $count);
}

# FIXME: mask
sub cmd_clear
{
	my ($param, $server, $witem) = @_;

	%auto_ban_type = ();
}

sub cmd_load
{
	my ($param, $server, $witem) = @_;
	load_bantypes($param ? $param : $bantype_file);
}

Irssi::settings_add_int("misc", "max_ban_user_mask_chars", 10);

Irssi::command_bind("bt", "cmd_bt");
Irssi::command_bind("bt add",  "cmd_add");
Irssi::command_bind("bt list", "cmd_list");
Irssi::command_bind("bt test", "cmd_test");
Irssi::command_bind("bt clear", "cmd_clear");
Irssi::command_bind("bt load", "cmd_load");
Irssi::command_bind("bt save", "cmd_save");
Irssi::command_bind("bt ban", "cmd_ban");
Irssi::command_bind("bt kickban", "cmd_kickban");

Irssi::signal_add("redir bt test host", "sig_test_userhost");
Irssi::signal_add("redir bt ban host", "sig_ban_userhost");

load_bantypes();
