#!/usr/bin/perl

# Copyright (C) 2008 Christoph Berg <myon@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.

use warnings;
use strict;
use Net::IRC;
use Data::Dumper;

$| = 1;

my $hosttestre = '[a-z0-9.^*()\[\]|_+-]+'; # list of chars for host/test patterns
my $channel = $ENV{IRC_CHANNEL} || die ("IRC_CHANNEL is not set");
my $access = $ENV{IRC_ACCESS} || ".*";

print scalar(localtime) . " Connecting to $ENV{IRC_SERVER}\n";

my $irc = new Net::IRC;
my $conn = $irc->newconn (
	Nick	=> $ENV{IRC_NICK} || die ("IRC_NICK is not set"),
	Server	=> $ENV{IRC_SERVER} || die ("IRC_SERVER is not set"),
	Port	=> $ENV{IRC_PORT} || 6667,
	Username => $ENV{IRC_USER} || 'hobbit',
	Ircname	=> $ENV{IRC_IRCNAME} || 'Hobbit monitor bot',
	SSL	=> $ENV{IRC_SSL} ? 1 : 0,
);

sub reply
{
	my $event = shift;
	if ($event->{to}->[0] =~ /^#/) {
		return $event->{to}->[0];
	} else {
		return $event->{nick};
	}
}

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;
	if ($age <= 60) {
		return sprintf ('%ds', $age);
	} elsif ($age <= 3600) {
		return sprintf ('%.1fm', $age / 60.0);
	} elsif ($age <= 86400) {
		return sprintf ('%.1fh', $age / 3600.0);
	} elsif ($age <= 90 * 86400) {
		return sprintf ('%.1fd', $age / 86400.0);
	} else {
		return sprintf ('%.1fmon', $age / (30 * 86400.0));
	}
}

sub on_connect
{
	my $self = shift;
	print scalar (localtime) . " Joining $channel\n";
	$self->join ($channel);
}

sub on_msg
{
	# get input
	my $conn = $_[0];
	my $event = $_[1];
	my $msg = substr ($event->{args}->[0], 0, 100);
	chomp $msg;
	$msg =~ s/[^[:print:]]/ /g;
	return unless ($msg =~ /^(help|hosts?|status|query|clear|green|yellow|red|purple|blue)\b/);

	# check access
	my $date = scalar localtime;
	my $from = $event->{from};
	if ($from !~ /^($access)$/io) {
		print "$date Denied access for $from ($msg)\n";
		return;
	}

	# parse stuff
	if ($msg =~ /^help\b/i) {
		$conn->notice (reply ($event),
			"List of commands: " .
			"hosts [HOST [TEST]], status [HOST [TEST]], COLOR, help");

	} elsif ($msg =~ /^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);
		$conn->notice (reply ($event), $txt);

	} elsif ($msg =~ /^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 /\|/;
			$conn->notice (reply ($event),
				"10$hostname $testname: " . color ($color, $color) .
				" for " . age ($lastchange) .
				", reported " . age ($logtime) . " ago");
			sleep 1;
			if ($disabletime != 0) {
				my $until = $disabletime == -1 ? "OK" :
					scalar (localtime ($disabletime));
				my %quote = ( '\\' => '\\', n => ' ',
					p => '|', r => ' ', t => ' ' );
				$dismsg =~ s/\\([\\nprt])/$quote{$1}/g;
				$conn->notice (reply ($event),
					"Test disabled until $until: $dismsg");
				sleep 1;
			}
		}
		close F;
		if ($ntests > 5) {
			$conn->notice (reply ($event), "... " . ($ntests - 5) . " more");
		}

	} elsif ($msg =~ /^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}});
			$conn->notice (reply ($event), "10$host: $status");
			sleep 1;
		}
		if ($nhosts > 5) {
			$conn->notice (reply ($event), "... " . ($nhosts - 5) . " more");
		}

	} elsif ($msg =~ /^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 );
		$conn->notice (reply ($event),
			"status: $hosts hosts, $services services,$status");

	} elsif ($msg =~ /^(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) {
				$conn->notice (reply ($event),
					"10$host $test: " .
					color ($color, $color) . " for " .
					age ($last) . ", reported " .
					age ($logtime) . " ago");
				sleep 1;
			}
		}
		close F;
		if ($services == 0) {
			$conn->notice (reply ($event),
				"no " . color ($color, $color) . " services");
		}
		if ($services > 5) {
			$conn->notice (reply ($event),
				"... " . ($services - 5) . " more");
		}

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

	} else {
		return;
	}

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

sub on_stdin
{
	exit if eof (STDIN);
	my $line = <STDIN>;
	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.df7cb.de|hobbitd|127.0.0.1|1204302290|green|yellow|1204300490||-1|linux|linux|
	# @@page#1|1204302889.833747|127.0.0.1|hubble.df7cb.de|bat|10.81.1.7|1204304689|red|clear|1204302889||404645|||
	if ($list[0] =~ /^\@\@page/) {
		return if ($list[7] eq $list[8]); # no change
		my $msg = "10$list[3] $list[4] is " .
			color ($list[7], $list[7]) .
			" (was " . color ($list[8], $list[8]) . ")";
		if ($list[7] eq 'blue') {
			open F, "bb $ENV{BBDISP} 'hobbitdboard host=$list[3] test=$list[4] 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/ / until $until /;
			$msg .= " $dismsg";
		}
		if ($list[7] =~ /clear|green/) {
			$conn->notice ($channel, $msg);
		} else {
			$conn->privmsg ($channel, $msg);
		}
		sleep 2; # be nice
	}
}


$conn->add_global_handler('376', \&on_connect);     # global
$conn->add_handler('msg', \&on_msg);                # local
$conn->add_handler('public', \&on_msg);                # local

$irc->addfh( \*STDIN, \&on_stdin, "r" );

$irc->start;
