#!/usr/bin/perl

# Copyright (C) 2008, 2009, 2010  Christoph Berg <myon@debian.org>
# Copyright (C) 2010, 2012        Axel Beckert <abe@debian.org>
#
# Permission is hereby granted, free of charge, to any person
# obtaining a copy of this software and associated documentation
# files (the "Software"), to deal in the Software without
# restriction, including without limitation the rights to use,
# copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the
# Software is furnished to do so, subject to the following
# conditions:
#
# The above copyright notice and this permission notice shall be
# included in all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
# OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
# HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
# OTHER DEALINGS IN THE SOFTWARE.

# Hobbit-to-IRC bot. Should be running from hobbitd_channel --channel=page.

use warnings;
use strict;
use POE qw(Component::IRC::State Component::IRC::Plugin::AutoJoin Wheel::ReadWrite);
use Data::Dumper;

my $hosttestre = '[a-z0-9.^*()\[\]|_+-]+'; # chars for host/test patterns
my $nick = $ENV{IRC_NICK} || die ("IRC_NICK is not set");
my $channel = $ENV{IRC_CHANNEL} || die ("IRC_CHANNEL is not set");
my $server = $ENV{IRC_SERVER} || die ("IRC_SERVER is not set");
my $access = $ENV{IRC_ACCESS} || ".*";
my $sleep = $ENV{IRC_SLEEP} || "0";
my $green_privmsg = $ENV{IRC_GREEN_PRIVMSG} || "0";
my $alertNicks = $ENV{ALERT_NICKS} || '';
my @alertHosts = split /[, ]+/, $ENV{ALERT_HOSTS};
my @alertIgnore = split /[, ]+/, $ENV{ALERT_IGNORE};
my %lastchange; # %lastchange{$host}->{$test} = $timestamp

print scalar(localtime) . " Connecting to $server\n";

my $irc = POE::Component::IRC::State->spawn() or die "Oh noooo! $!";

POE::Session->create(
    inline_states => {
	_start           => \&on_start,
	irc_disconnected => \&do_connect,
	irc_001          => \&on_connect,
	irc_public       => \&on_msg,
	irc_msg          => \&on_msg,
	got_input        => \&on_stdin,
    },
);

sub bb
{
	my $msg = shift;
	system ("bb", $ENV{BBDISP}, $msg);
}

sub color
{
	my %color = (
		green => 3,
		yellow => 7,
		red => 4,
		purple => 6,
		blue => 2,
	);
	my $color = shift;
	my $text = shift;
	return "$color{$color}$text" if (exists ($color{$color}));
	return $text;
}

sub age
{
	my $age = time - shift;
	$age = -$age if ($age < 0);
	if ($age <= 60) {
		return sprintf ('%ds', $age);
	} elsif ($age <= 3600) {
		return sprintf ('%dm%ds', $age/60.0, $age % 60);
	} elsif ($age <= 86400) {
		return sprintf ('%dh%dm', $age/3600.0, ($age % 3600)/60.0);
	} elsif ($age <= 90 * 86400) {
		return sprintf ('%dd%dh', $age/86400.0, ($age % 86400)/3600.0);
	} else {
		return sprintf ('%.1fmon', $age / (30 * 86400.0));
	}
}

sub dismsg ($$)
{
	my ($host, $test) = @_;
	open F, "bb $ENV{BBDISP} 'hobbitdboard host=$host test=$test fields=disabletime,dismsg' |";
	my $ret = <F>;
	chomp $ret;
	close F;
	my ($disabletime, $dismsg) = split /\|/, $ret;
	my $until = $disabletime == -1 ? "OK" :
		scalar (localtime ($disabletime));
	my %quote = ( '\\' => '\\', n => ' ',
			p => '|', r => ' ', t => ' ' );
	$dismsg =~ s/\\([\\nprt])/$quote{$1}/g;
	$dismsg =~ s/^ +//;
	return "until $until $dismsg";
}

sub get_cookie ($$)
{
	my ($host, $test) = @_;
	open F, "bb $ENV{BBDISP} 'hobbitdboard host=$host test=$test fields=cookie' |";
	my $cookie = <F>;
	close F;
	return undef if (not $cookie or $cookie == -1);
	chomp $cookie;
	return $cookie;
}

sub on_start
{
    $_[HEAP]{client} = POE::Wheel::ReadWrite->new(
        InputHandle => \*STDIN,
        OutputHandle => \*STDOUT,
        InputEvent => "got_input"
    );

    $irc->plugin_add('AutoJoin',
		     POE::Component::IRC::Plugin::AutoJoin->new(
			 Channels => { $channel => '' }
		     ));
    $irc->yield(register => "all");
    do_connect(@_);
}

sub do_connect
{
    $irc->yield(
	connect => {
	    Nick	=> $nick,
	    Ircname	=> $ENV{IRC_IRCNAME} || 'Hobbit monitor bot',
	    Username	=> $ENV{IRC_USER} || 'hobbit',
	    Server	=> $server,
	    Port	=> $ENV{IRC_PORT} || 6667,
	    UseSSL	=> $ENV{IRC_SSL} ? 1 : 0,
	    Flood	=> 1, # for now
	}
    );
}

sub on_connect
{
	my $self = shift;

	# read current status
	open F, "bb $ENV{BBDISP} 'hobbitdboard fields=hostname,testname,lastchange' |";
	my $count = 0;
	while (my $line = <F>) {
		chomp $line;
		my ($hostname, $testname, $lastchange) = split /\|/, $line;
		next unless ($lastchange);
		$lastchange{$hostname}->{$testname} = $lastchange;
		$count++;
	}
	close F;

	print scalar (localtime) .
	    " Joining $channel, got $count status reports from hobbitd\n";
	$irc->yield(join => $channel);
}

sub on_msg
{
	# get input
	my ($kernel, $from, $where, $msg) = @_[KERNEL, ARG0, ARG1, ARG2];
	chomp $msg;
	$msg =~ s/[^[:print:]]/ /g;
	return unless ($msg =~ /^($nick: )?(help|disable|enable|drop|ack|hosts?|status|query|clear|green|yellow|red|purple|blue)\b/);

	# check access
	my $date = scalar localtime;
	my $peer = (split /!/, $from)[0];
	my $channel = $where->[0];
	# Source: https://www.alien.net.au/irc/chantypes.html
	$channel = undef unless $channel =~ /^[#&!+.~]/;
	my $reply = $channel ? $channel : $peer;

	if ($from !~ /^($access)$/io) {
		print "$date Denied access for $from ($msg)\n";
		return;
	}

	# parse stuff
	if ($msg =~ /^($nick: )?help\b/i) {
		$irc->yield(notice => $reply,
			"List of commands: " .
			"help disable enable drop ack hosts status query <COLOR>");

	} elsif ($msg =~ /^$nick: disable ($hosttestre)[ .]($hosttestre) (\S+) (.+)/io) {
		my ($host, $test, $time, $reason) = ($1, $2, $3, $4);
		$time =~ s/ok/-1/i;
		bb ("disable $host.$test $time Disabled by $peer: $reason");

	} elsif ($msg =~ /^$nick: enable ($hosttestre)[ .]($hosttestre)/io) {
		my ($host, $test) = ($1, $2);
		bb ("enable $host.$test");

	} elsif ($msg =~ /^$nick: drop ($hosttestre)[ .]($hosttestre)/io) {
		my ($host, $test) = ($1, $2);
		if ($test eq '*') {
			bb ("drop $host");
		} else {
			bb ("drop $host $test");
		}

	} elsif ($msg =~ /^$nick: ack(?:nowledge)? ($hosttestre)[ .]($hosttestre) (.+)/io) {
		my ($host, $test, $time_reason) = ($1, $2, $3);
		if (my $cookie = get_cookie ($host, $test)) {
			$time_reason = "1h $time_reason" unless ($time_reason =~ /^\d/);
			bb ("hobbitdack $cookie $time_reason  Acked by $peer");
		} else {
			$irc->yield(notice => $reply, "No alert cookie for $host $test");
		}

	} elsif ($msg =~ /^(?:$nick: )?hosts?(?:\s+($hosttestre)(?:\s+($hosttestre))?)?/io) {
		my $host = $1 || '*';
		my $test = $2 || 'info';
		open F, "bb $ENV{BBDISP} 'hobbitdboard host=$host test=$test fields=hostname,color' |";
		my %hosts;
		while (<F>) {
			chomp;
			my ($hostname, $color) = split /\|/;
			$hosts{$hostname} = $test eq 'info' ? 'clear' : $color;
		}
		close F;

		my @hosts = sort keys %hosts;
		my $nhosts = scalar @hosts;
		@hosts = @hosts[0 .. 19] if $nhosts > 20;
		my $txt = join (' ', map { color ($hosts{$_}, $_) } @hosts);
		$txt = "no hosts found" if $nhosts == 0;
		$txt .= " ... " . ($nhosts - 20) . " more" if ($nhosts > 20);
		$irc->yield(notice => $reply, $txt);

	} elsif ($msg =~ /^(?:$nick: )?status\s+($hosttestre)\s+($hosttestre)/io) {
		my ($host, $test) = ($1, $2);
		open F, "bb $ENV{BBDISP} 'hobbitdboard host=$host test=$test fields=hostname,testname,color,lastchange,logtime,disabletime,dismsg' |";
		my $ntests;
		while (<F>) {
			next if (++$ntests > 5);
			chomp;
			my ($hostname, $testname, $color, $lastchange,
			    $logtime, $disabletime, $dismsg) = split /\|/;
			$irc->yield(notice => $reply,
				"10$hostname $testname: " .
				color ($color, $color) .
				" for " . age ($lastchange) .
				", reported " . age ($logtime) . " ago");
			sleep $sleep if $sleep;
			if ($disabletime != 0) {
				my $until = $disabletime == -1 ? "OK" :
					scalar (localtime ($disabletime));
				my %quote = ( '\\' => '\\', n => ' ',
					p => '|', r => ' ', t => ' ' );
				$dismsg =~ s/\\([\\nprt])/$quote{$1}/g;
				$irc->yield(notice => $reply,
					"Test disabled until $until: $dismsg");
				sleep $sleep if $sleep;
			}
		}
		close F;
		if ($ntests > 5) {
			$irc->yield(notice => $reply, "... " . ($ntests - 5) . " more");
		}

	} elsif ($msg =~ /^(?:$nick: )?status\s+($hosttestre)/io) {
		my $host = $1;
		open F, "bb $ENV{BBDISP} 'hobbitdboard host=$host fields=hostname,testname,color' |";
		my %test;
		while (<F>) {
			chomp;
			my ($hostname, $test, $color) = split /\|/;
			next if $test =~ /^(info|trends)$/;
			$test{$hostname}{$test} = $color;
		}
		close F;

		my $nhosts;
		for $host (sort keys %test) {
			next if (++$nhosts > 5);
			my $status = join (' ',
				map { color ($test{$host}{$_}, $_) }
				sort keys %{$test{$host}});
			$status = "unknown"
			    if (not scalar keys %{$test{$host}});
			$irc->yield(notice => $reply, "10$host: $status");
			sleep $sleep if $sleep;
		}
		if ($nhosts > 5) {
			$irc->yield(notice => $reply,
				       "... " . ($nhosts - 5) . " more");
		}

	} elsif ($msg =~ /^(?:$nick: )?status\b/io) {
		open F, "bb $ENV{BBDISP} 'hobbitdboard fields=hostname,testname,color' |";
		my (%host, $services, %color);
		while (<F>) {
			chomp;
			my ($host, $test, $color) = split /\|/;
			next if $test =~ /^(info|trends)$/;
			$host{$host} = 1;
			$services++;
			$color{$color}++;
		}
		close F;

		my $hosts = scalar keys %host;
		my $status = join ('', map { color ($_, " $color{$_} $_") } sort keys %color );
		$irc->yield(notice => $reply,
			"status: $hosts hosts, $services services,$status");

	} elsif ($msg =~ /^(?:$nick: )?(clear|green|yellow|red|purple|blue)\b/) {
		my $color = $1;
		open F, "bb $ENV{BBDISP} 'hobbitdboard fields=hostname,testname,lastchange,logtime color=$color' |";
		my $services = 0;
		while (<F>) {
			chomp;
			my ($host, $test, $last, $logtime) = split /\|/;
			next if $test =~ /^(info|trends)$/;
			$services++;
			if ($services <= 5) {
				$irc->yield(notice => $reply,
					"10$host $test: " .
					color ($color, $color) . " for " .
					age ($last) . ", reported " .
					age ($logtime) . " ago");
				sleep $sleep if $sleep;
			}
		}
		close F;
		if ($services == 0) {
			$irc->yield(notice => $reply,
				"no " . color ($color, $color) . " services");
		}
		if ($services > 5) {
			$irc->yield(notice => $reply,
				"... " . ($services - 5) . " more");
		}

	# not mentioned in 'help' as it is pretty boring
	} elsif ($msg =~ /^(?:$nick: )?query\s+($hosttestre)/i) {
		my $query = $1;
		my $ret = substr (`bb $ENV{BBDISP} 'query $query'`, 0, 100);
		chomp $ret;
		$ret =~ s/[^[:print:]]/ /g;
		$irc->yield(notice => $reply, "$query: " .
			       ($ret || "no result"));

	} else {
		return;
	}

	print "$date <$from> $msg\n";
	sleep $sleep if $sleep;
}

sub on_stdin
{
	my $line = $_[ARG0];
	chomp $line;
	return unless $line =~ /^@@./;
	#print "$line\n";
	my @list = split /\|/, $line;
	# 0        1                 2       3     4       5         6          7     8      9          10   11 12    13
	# @@page#2|1204300490.218654|hobbitd|tesla|hobbitd|127.0.0.1|1204302290|green|yellow|1204300490|page|-1|linux|linux|
	# @@page#1|1204302889.833747|127.0.0.1|hubble|bat|10.81.1.7|1204304689|red|clear|1204302889||404645|||
	if ($list[0] =~ /^\@\@page/) {
		my ($host, $test, $color, $oldcolor, $logtime) =
		    @list[3, 4, 7, 8, 9];
		return if ($color eq $oldcolor); # no change
		my $alertMsg = '';
		if ($alertNicks &&
		    grep(/$host/, @alertHosts) &&
		    !grep(/$test/, @alertIgnore) &&
		    ($color eq 'red')) {
			$alertMsg = $alertNicks.": ";
		}
		my $msg = "$alertMsg10$host " .
			color ($color, "$test $color") .
			" (was " . color ($oldcolor, $oldcolor) .
			($lastchange{$host}->{$test} ? " for " .
			 age ($lastchange{$host}->{$test}) : "") .
			")";
		if ($color eq 'blue') {
			$msg .= " " . dismsg ($host, $test);
		}
		if ($color =~ /clear|green/) {
			if ($green_privmsg) {
				$irc->yield(privmsg => $channel => $msg);
			} else {
				$irc->yield(notice => $channel => $msg);
			}
		} else {
			$irc->yield(privmsg => $channel => $msg);
		}
		$lastchange{$host}->{$test} = $logtime;
		sleep $sleep if $sleep;

	# 0                  1                 2             3 4   5      6          7      8     9        10 11 12 13
	# @@stachg#11280/sam|1268916763.289293|195.49.152.111||sam|bbtest|1268918563|yellow|green|1268696171|0||0|1268916705
	# @@stachg#11290/adweb|1268917833.154419|195.49.152.3||adweb|apt|2147483647|blue|yellow|1268910336|-1|Disabled by: cbe @ 10.1.1.1\nReason: Upgrade\n|0|1268917558
	} elsif ($list[0] =~ /^\@\@stachg/) { # untested
		my ($host, $test, $color, $oldcolor, $lastchange) = @list[4, 5, 7, 8, 9];
		return if ($color eq $oldcolor); # no change
		my $alertMsg = '';
		if ($alertNicks &&
		    grep(/$host/, @alertHosts) &&
		    !grep(/$test/, @alertIgnore) &&
		    ($color eq 'red')) {
			$alertMsg = $alertNicks.": ";
		}
		my $msg = "$alertMsg10$host " .
			color ($color, "$test $color") .
			" (was " . color ($oldcolor, $oldcolor) .
			($lastchange ? " since " .
			 scalar localtime ($lastchange) : "") .
			")";
		if ($color eq 'blue') {
			$msg .= " " . dismsg ($host, $test);
		}
		if ($color =~ /clear|green/) {
			if ($green_privmsg) {
				$irc->yield(privmsg => $channel => $msg);
			} else {
				$irc->yield(notice => $channel => $msg);
			}
		} else {
			$irc->yield(privmsg => $channel => $msg);
		}
		sleep $sleep if $sleep;

	# 0        1                 2         3    4   5          6
	# @@ack#12|1231428868.733473|127.0.0.1|benz|apt|10.81.0.10|1231429168
	} elsif ($list[0] =~ /^\@\@ack/) { # unfortunately there are no acks on "stachg" channel
		my ($host, $test, $acktime) = @list[3, 4, 6];
		open F, "bb $ENV{BBDISP} 'hobbitdboard host=$host test=$test fields=ackmsg' |";
		my $ackmsg = <F>;
		chomp $ackmsg;
		close F;
		my %quote = ( '\\' => '\\', n => ' ',
			p => '|', r => ' ', t => ' ' );
		$ackmsg =~ s/\\([\\nprt])/$quote{$1}/g;

		my $msg = "10$host $test acknowledged for " .
			age ($acktime) . ": $ackmsg";
		$irc->yield(privmsg => $channel => $msg);

	# 0                  1                 2       3     4
	# @@droptest#11924/*|1272016619.152373|1.4.1.1|dbsrv|postgres
	} elsif ($list[0] =~ /^\@\@droptest/) {
		my ($host, $test) = @list[3, 4];
		my $msg = "10$host $test dropped";
		$irc->yield(privmsg => $channel => $msg);
		delete $lastchange{$host}->{$test};

	# @@logrotate#224/*|1271219105.493869|hobbitd|
	} elsif ($list[0] =~ /^\@\@logrotate/) {
		# do nothing

	} else {
		print scalar (localtime) . " Could not parse $line\n";
	}
}

$poe_kernel->run();