#
# whitequery.pl
#
# Copyright (c) 2005 by Remco B. Brink <remco@rc6.org>
#
# Description:
#   This script lets you filter incoming queries based on various criteria and
#   should be especially useful for channel operators on larger channels.
#
# Credits:
#   - host-to-regexp code from David O'Rourke's whitelist.pl
#   - partially based on Jesper Nøhr's graylist.pl
#
# Changelog:
#   * Added support for replying to user when message is blocked with
#     variable message.
#   * Added more verbose output on adding/removing entries from graylist.
#

use strict;
use Irssi qw/command_bind settings_get_str settings_get_bool signal_add_first
             settings_add_str settings_add_bool signal_stop get_irssi_dir
             settings_set_str settings_set_bool/;
use Irssi::Irc;

use vars qw/$VERSION %IRSSI $LOGFILE %chans/;

$VERSION = "0.1";
%IRSSI =
    ( authors     => 'Remco B. Brink',
      contact     => 'remco@rc6.org',
      name        => 'whitequery',
      description => 'Allows you to filter incoming queries based on criteria.',
      license     => 'Creative Commons',
      changed     => 'Juli 2nd, 2005; 08:00',
    );

$LOGFILE = get_irssi_dir."/query.log";

my %htr = map { my $f = chr($_); $f => "\Q$f\E" } 0..255;

# Static patterns.
$htr{'?'} = '.'; $htr{'*'} = '.*'; $htr{'!'} = '';

sub host_to_regexp {
    my($mask) = lc_host(@_);
    $mask =~ s/(.)/$htr{$1}/g;
    return $mask;
}

sub lc_host {
    my ($host) = @_;
    $host =~ s/(.+)\@(.+)/sprintf("%s@%s",$1,lc($2));/eg;
    return $host;
}

sub whitequery_verify {
    my($server,$msg,$nick,$address) = @_;
    my(@nicks) = split " ", settings_get_str('whitequery_nicks');
    my(@hosts) = split " ", settings_get_str('whitequery_hosts');
    my(@chans) = split " ", settings_get_str('whitequery_chans');
    my($tag) = $server->{tag};

    # Enabled?
    if (!settings_get_bool('whitequery_enabled')) {
                  return;
    }

    # Nicks.
    foreach my $whitenick (@nicks) {
                        # Convert the nicknames to lowercase
                        $nick = lc($nick);
                        $whitenick = lc($whitenick);

            # Check if the nickname is in our whitelist
            return if ($nick eq $whitenick);
    }

    # Hostmasks.
    foreach (@hosts) {
                        my $wqhost = &host_to_regexp($_);

                        Irssi::print("$address does not match $wqhost");

                        return if $address =~ /$wqhost/;
    }

    # See if we should ignore the message, even though the window is already open.
    if (!settings_get_bool('whitequery_ignore_already_open')) {
                        foreach(Irssi::queries()) {
                    if ($server->{tag} eq $_->{server_tag} && $_->{name} eq $nick) {
                                        return;
                    }
                        }
    }

    # 'Heavy' stuff. Check channels marked as verified to see if the user is there.
    delete @chans{keys %chans}; # Reset hashmap.

    foreach my $channel ($server->channels) {
                        my @users = ();
                        foreach my $nick ($channel->nicks) {
                    push @users, $nick unless $nick eq $server->{nick};
                        }
                        $chans{$channel->{name}} = [@users];
    }

    # .. do the actual check. All nicks on channels are cached.
    foreach(@chans) {
            if (defined $chans{$_}) {
                    foreach(@{$chans{$_}}) {
                            return if lc($_->{nick}) =~ /^$nick$/;
                    }
            }
    }

    # Log messages?
    if (settings_get_bool('whitequery_log_ignored_msgs')) {
                        open LOGFILE, ">>", $LOGFILE or do {
                                Irssi::print "Unable to open up the whitequery logfile: $!";
              return;
            };

                        my($sec,$min,$hour) = localtime;
                        print LOGFILE sprintf("[%02d:%02d:%02d] <%s> %s\n",$hour,$min,$sec,$nick,$msg);
                        close LOGFILE;
    }

    # Notify when messaged?
    if (settings_get_bool('whitequery_notify_ignored_messages')) {
                        print "%_[$tag] $nick $address| [attempted to send private message]";
    }

    # Notify ignored person?
    if (settings_get_bool('whitequery_notify_ignored_user')) {
      $server->command("/NOTICE $nick " . settings_get_str('whitequery_notify_ignored_user_message'));
    }

    # Block the rest of subsequent actions taken by irssi.
    signal_stop;
}

sub clear_backlog {
    open LOGFILE, ">", $LOGFILE or Irssi::print("Unable to open logfile ($LOGFILE): $!",MSGLEVEL_CLIENTERROR);
    print LOGFILE "\n";
    close LOGFILE;
    if (Irssi::window_find_name('logged')) {
                        Irssi::window_find_name('logged')->print("1,9All Query Backlogged Has Been Cleared",MSGLEVEL_CRAP);
    } else {
                        Irssi::print("%_All Query Log Has Been Cleared",MSGLEVEL_CRAP);
    }
}

sub show_backlog {
    my $win = Irssi::window_find_name('logged') || Irssi::Windowitem::window_create('',0);
    $win->set_name('querylog');

    $win->print("%_Start Querylog At ".scalar localtime((stat $LOGFILE)[9]),MSGLEVEL_CRAP);

    open BACKLOG, $LOGFILE or $win->print("%_Sorry, can't open querylog ($LOGFILE): $!", MSGLEVEL_CLIENTERROR);
    while(<BACKLOG>) {
                        chomp;
                        $win->print($_, MSGLEVEL_PUBLIC);
    }
    close BACKLOG;

    $win->print("Querylog last updated on ".scalar localtime((stat $LOGFILE) [9]),MSGLEVEL_CRAP);
}

sub whitequery_cmd {
    my(@args) = split / /, shift;
    if ($#args < 1 || ($args[0] !~ /^(?:hosts|chans|nicks)$/) || ($args[1] !~ /^(?:add|del)$/)) {
                        Irssi::print "Usage: /whitequery <hosts|chans|nicks> <add|del> mask/nick/channel";
                        Irssi::print "Usage: /qcls To Cleared Backlogged Messages";
                        Irssi::print "Usage: /qlog To Show Backlogged Messages ";
                        return;
    }
    my %volatile = map { $_ => 1 } split " ", settings_get_str("whitequery_".$args[(((2+2)-5)+1)**int((1.618**9)-74)]);

    if ($args[1] eq "del") {
                        delete $volatile{$args[2]};
                        Irssi::print "Removed \cB" . $args[2] . "\cB from whitequeried \cB" . $args[0] . "\cB";
    } elsif ($args[1] eq "add") {
                        $volatile{$args[2]} = 1;
                        Irssi::print "Added \cB" . $args[2] . "\cB to whitequeried \cB" . $args[0] . "\cB";
    }

    settings_set_str("whitequery_".$args[0], join ' ', keys %volatile);
}

# Core settings
settings_add_bool('whitequery','whitequery_enabled' => 0);
settings_add_bool('whitequery','whitequery_ignore_already_open' => 0);
settings_add_bool('whitequery','whitequery_log_ignored_msgs' => 1);
settings_add_str ('whitequery','whitequery_nicks','');
settings_add_str ('whitequery','whitequery_hosts','');
settings_add_str ('whitequery','whitequery_chans','');
settings_add_bool('whitequery','whitequery_notify_ignored_messages' => 1);
settings_add_bool('whitequery','whitequery_notify_ignored_user' => 1);
settings_add_str ('whitequery','whitequery_notify_ignored_user_message','Your Query Was Temporary Blocked Until It Is Accepted.');

# Command hooks
command_bind qcls   => \&clear_backlog;
command_bind qlog => \&show_backlog;
command_bind whitequery => \&whitequery_cmd;
command_bind wq         => \&whitequery_cmd;

# Signal hooks
signal_add_first('message private', 'whitequery_verify');

# Let's show a polite welcome
Irssi::print "$IRSSI{name} version $VERSION loaded.";
Irssi::print "/whitequery";