###################################################################
# DroneBL RPC2 query for irssi
# This script allows querying the DroneBL using RPC2 calls, which
# will allow queries including wildcards and ranges.  Examples:
# /dronebl 127.0.0.?
# /dronebl 10.0.*
# /dronebl 192.168.[1-20].*
#
# For more information:
# /dronebl help
#
# Requires LWP::UserAgent (which you probably already have),
# HTTP::Request and Text::TabularDisplay
#
# This program is free software. It comes without any warranty, to
# the extent permitted by applicable law. You can redistribute it
# and/or modify it under the terms of the Do What The Fuck You Want
# To Public License, Version 2, as published by Sam Hocevar. See
# http://sam.zoy.org/wtfpl/COPYING for more details.
###################################################################

use vars qw($VERSION %IRSSI);
use Irssi qw(command_bind settings_get_str settings_add_str settings_get_bool settings_add_bool);
use LWP::UserAgent;
use HTTP::Request::Common;
use Text::TabularDisplay;

$VERSION = '0.4';
%IRSSI = (
	authors		=> 'Steve Church (rojo)',
	contact		=> 'irc.atheme.org on #dronebl',
	name		=> 'DroneBL RPC2 query',
	description	=> 'query the DroneBL with wildcards via irssi',
	license		=> 'WTFPLv2',
	url		=> 'http://headcandy.org/rojo/',
	changed		=> $VERSION,
	modules		=> 'LWP::UserAgent HTTP::Request Text::TabularDisplay',
	commands	=> 'dronebl'
);

settings_add_str('DroneBL', 'dronebl_rpckey', '');
settings_add_str('DroneBL', 'dronebl_columns', 'listed ip type timestamp');
settings_add_bool('DroneBL', 'dronebl_show_only_active', 0);
settings_add_bool('DroneBL', 'dronebl_show_type_names', 0);

my $rpcKey = settings_get_str('dronebl_rpckey');
my $userAgent = LWP::UserAgent->new(agent => 'perl post');
my $DroneBL = "http://dronebl.org/RPC2";
my $classes_page = "http://dronebl.org/classes?format=txt";
my %classes;

if (!$rpcKey) {
	&dronebl_nag(0);
}

command_bind dronebl => sub {
	my ($data, $server, $channel) = @_;
	my $query;
	my $response;
	my $xml;
	my $error;
	my $error_message;
	my $error_query;
	my $item;
	my $line;
	my @lines;
	my @params;
	my $matches = 0;
	my $active = 0;
	my $expired = 0;

	if (index("help",$data) ne -1) {
		&dronebl_help($channel);
		return;
	}

	my $rpcKey = settings_get_str('dronebl_rpckey');
	if (!$rpcKey) {
		&dronebl_nag($channel);
		return;
	}
	my $message = "<?xml version=\"1.0\"?>\n<request key='$rpcKey'>\n";
	# valid characters in queries include ?*%_[]-
	foreach $query (split(/[^0-9\.\?\*\%\_\[\]\-]+/,$data)) {
		$message .= "	<lookup ip='$query' />\n";
	}
	$message .= "</request>";
	$response = $userAgent->request(POST $DroneBL, Content_Type => 'text/xml', Content => $message);
	if ($response->is_success) {
		$xml = $response->as_string;
		@lines = split(/\n/, $xml);
		if (grep(/error/, $xml)) {
			foreach $line (@lines) {
				if (grep(/<code>/, $line)) { $error = $line; }
				if (grep(/<message>/, $line)) { $error_message = $line; }
				if (grep(/<data>/,$line)) { $error_query = $line; }
			}
			$error =~ s/\s*<\/*[^>]+>//g;
			$error_message =~ s/\s*<\/*[^>]+>//g;
			$error_query =~ s/\s*<\/*[^>]+>//g;
			$error_query =~ s/\%/\%\%/g;
			&dronebl_print("The server returned an error message ($error: $error_message)", $channel);
			if ($error_query) { &dronebl_print("Extended information: $error_query", $channel); }
			return;
		}
		my @columns = split(/\s+/, settings_get_str('dronebl_columns'));
		my $table = Text::TabularDisplay->new(@columns);
		foreach $line (@lines) {
			if (grep(/<result/, $line)) {
				++$matches;
				@params = split(/\s/, $line);
				my %keys;
				foreach $item (@params) {
					if (grep(/=/, $item)) {
						$item =~ s/"//g;
						my @temp = split(/=/, $item);
						$keys{@temp[0]} = @temp[1];
					}
				}
				if (!settings_get_bool('dronebl_show_only_active') || $keys{"listed"} eq 1) {
					if ($keys{"listed"} eq 1) {
						++$active;
						$keys{"listed"} = "yes";
					}
					else { $keys{"listed"} = "no"; }
					if (time - (86400 * 90) ge scalar $keys{"timestamp"}) {
						++$expired;
						$keys{"listed"} .= " (exp)";
					}
					$keys{"timestamp"} = scalar gmtime($keys{"timestamp"});
					$keys{"type"} .= " (" . &dronebl_class($keys{"type"}) . ")" unless !settings_get_bool('dronebl_show_type_names') || !&dronebl_class($keys{"type"});
					my @row;
					foreach my $column (@columns) {
						push(@row, $keys{$column});
					}
					$table->add(@row);
				}
			}
		}
		my @table = split(/\n/, $table->render);
		foreach my $row (@table) {
			&dronebl_print("%8%#" . $row . "%#%8", $channel);
		}
		&dronebl_print("%W%Nquery: $data | matches: $matches | active: $active | expired: $expired", $channel);
	}
	else {
		&dronebl_print($response->error_as_HTML, $channel);
	}
};

sub dronebl_print {
	my ($data, $channel) = @_;
	if ($channel->{type} eq "CHANNEL") {
		$channel->print($data, MSGLEVEL_CLIENTCRAP);
	}
	else {
		print CLIENTCRAP $data;
	}

};

sub dronebl_help {
	my ($channel) = @_;
	my $help = "
%W%8DroneBL RPC2 query for irssi%8 %N
%W%NThis script allows querying the DroneBL using RPC2 calls, which
%W%Nwill allow queries including wildcards and ranges.  Examples:
%W/dronebl 127.0.0.?%N
%W/dronebl 10.0.*%N
%W/dronebl 192.168.[1-20].*%N

%W%NRequires LWP::UserAgent (which you probably already have),
%W%NHTTP::Request and Text::TabularDisplay

%W%NAlso requires an RPCKey.  Set the key by typing the following:
%W/set dronebl_rpckey XXXXXXXXXXXXXXXXXXXXXXXXXXX%N
%W%Nreplacing the X's with your key, of course.  If you are a network
%W%Nsecurity professional and you do not have an RPCKey, one can be
%W%Nrequested from %chttp://dronebl.org/rpckey_signup%n

%W%NYou can change the format of the output by setting the 
%Wdronebl_columns%N variable.  Valid columns are as follows:
%W        ip id type comment listed timestamp%N
%W%NAdd / remove / rearrange columns as you see fit.  Example:
%W/set dronebl_columns listed ip type timestamp%N

%W%NIf you have the screen real-estate, you can expand the \"type\"
%W%Ncolumn numbers into their canonical names by setting the
%Wdronebl_show_type_names%N variable to %WON%N.

%W%NFinally, you can ignore inactive entries by setting the
%Wdronebl_show_only_active%N variable to %WON%N.
";
	&dronebl_print($help, $channel);
};

sub dronebl_nag {
	my ($channel) = @_;
	my $nag_message = "
Please store an RPCKey.  You will be unable to make queries until
you have done so.  Set the key by typing the following:

%W/set dronebl_rpckey XXXXXXXXXXXXXXXXXXXXXXXXXXX%N

replacing the X's with your key, of course.  If you are a network
security professional and you do not have an RPCKey, one can be
requested from %W%N%chttp://dronebl.org/rpckey_signup%n

For more options, see %W/dronebl help%N
";
	&dronebl_print($nag_message, $channel);
};

sub dronebl_class {
	my ($category) = @_;
	my $default = "Not yet implemented";
	if (keys(%classes) < 1) {
		&dronebl_print("Fetching up-to-date category descriptions...", $channel);
		my $response = $userAgent->request(GET $classes_page);
		if ($response->is_success) {
			foreach my $line (split(/\n/, $response->as_string)) {
				if (grep(/\t/, $line)) {
					my @parms = split(/\t/, $line);
					$classes{@parms[0]} = @parms[1];
				}
			}
		}
		else { $default = 0; }
	}
	if (defined $classes{$category}) {
		return $classes{$category};
	}
	else {
		return $default;
	}
};