Munin contributed plugins

#!/usr/bin/perl

# -*- perl -*-

=head1 NAME

ircstats  - Plugin to graph data about an IRC network and a single IRC server

=head1 CONFIGURATION

- ENV{SERVER} to point to the server to connect to, defaults to localhost.

- ENV{NICK} nickname to use, defaults to munin-$HASH.

=head1 USAGE

This plugin connects to an IRC server.

=head1 AUTHOR

Robin H. Johnson

=head1 LICENSE

3-clause BSD.

=head1 MAGIC MARKERS

  #%# family=manual

=cut

use strict;

use warnings;

use POE qw(Component::IRC);

use Digest::MD5 qw(md5_hex);

my $nickname = $ENV{NICK} || 'munin-'.md5_hex(rand().time());

my $ircname = "Munin statistics gathering from $ENV{FQDN}";

my $server = $ENV{SERVER} || 'localhost';

if($ARGV[0] and $ARGV[0] eq "config") {

    print "host_name $server\n";

    print "graph_title ircd status - $server\n";

    print "graph_category chat\n";

    print "graph_order clients channels servers localclients clientmax localclientmax localservers opers unknownconns\n";

    print "graph_args -l 0\n";

    print "clients.label clients\n";

    print "clients.draw LINE2\n";

    print "channels.label channels\n";

    print "channels.draw LINE2\n";

    print "servers.label servers\n";

    print "servers.draw LINE2\n";

    print "localclients.label localclients\n";

    print "localclients.draw LINE2\n";

    print "clientmax.label clientmax\n";

    print "clientmax.draw LINE2\n";

    print "localclientmax.label localclientmax\n";

    print "localclientmax.draw LINE2\n";

    print "opers.label opers\n";

    print "opers.draw LINE2\n";

    print "localservers.label localservers\n";

    print "localservers.draw LINE2\n";

    print "unknownconns.label unknownconns\n";

    print "unknownconns.draw LINE2\n";

    exit 0;

}

my %result;

# We create a new PoCo-IRC object

my $irc = POE::Component::IRC->spawn(

   nick => $nickname,

   ircname => $ircname,

   server => $server,

   raw => 0,

   useipv6 => 0,

) or die "Oh noooo! $!";

POE::Session->create(

    package_states => [

        main => [ qw(_start irc_001 irc_251 irc_252 irc_253 irc_254 irc_255 irc_265 irc_266 irc_372 irc_375 irc_376 irc_public irc_disconnected ) ], # _default

    ],

    heap => { irc => $irc },

);

$poe_kernel->run();

my $RPL_LUSER_CLIENT = 251;

my $RPL_LUSERCHANNELS = 254;

my $RPL_ENDOFMOTD = 376;

sub _start {

	my ($heap,$kernel,$sender) = @_[HEAP,KERNEL,SENDER];

    # retrieve our component's object from the heap where we stashed it

    my $irc = $heap->{irc};

    #$irc->yield( register => {("001", "$RPL_LUSER_CLIENT", "$RPL_LUSERCHANNELS", "$RPL_ENDOFMOTD", 'disconnected', 'public', 'all')} );

    $irc->yield( register => qw(001 251 252 253 254 255 265 266 372 375 376 disconnected public all) );

	#$kernel->post( $sender => register => qw(001 251 254 376 disconnected public all));

	#$kernel->post($sender, 'register', qw(001 251 254 376 disconnected public all));

    $irc->yield( connect => { } );

    return;

}

sub irc_001 {

    my $sender = $_[SENDER];

    # Since this is an irc_* event, we can get the component's object by

    # accessing the heap of the sender. Then we register and connect to the

    # specified server.

    my $irc = $sender->get_heap();

    #print "Connected to ", $irc->server_name(), "\n";

    # we join our channels

    #$irc->yield( join => $_ ) for @channels;

	#sleep 1;

	$irc->yield( quit => { });

    return;

}

#irc_251:  'moo.us.p2p-network.net' 'There are 155 users and 3397 invisible on 16 servers' [There are 155 users and 3397 invisible on 16 servers]

# luserclient

sub irc_251 {

    #print "In 251\n";

    my $sender = $_[SENDER];

    my $irc = $sender->get_heap();

	my $s = $_[ARG1];

	# Do we have something like an UnrealIRCD?

	if($s =~  /There are (\d+) users and (\d+) invisible on (\d+) servers/) {

		$result{'clients'} = $1 + $2 - 1; # don't count this script

		$result{'servers'} = $3;

	}

    # Or maybe some freendode hyperion stuff?

	elsif($s =~  /There are (\d+) listed and (\d+) unlisted users on (\d+) servers/) {

		$result{'clients'} = $1 + $2 - 1; # don't count this script

		$result{'servers'} = $3;

	}

    # Or some recent ircnet ircd?

    elsif($s =~  /There are (\d+) users and \d+ services on (\d+) servers/) {

		$result{'clients'} = $1 - 1; # don't count this script

		$result{'servers'} = $2;

    }

    # Anything else goes here

    elsif($s =~  /There are (\d+) users and (\d+) invisible/) {

		$result{'clients'} = $1 + $2 - 1; # don't count this script

    }

    # And here (if there are no invisible count)

    elsif($s =~  /There are (\d+) users/) {

		$result{'clients'} = $1 - 1; # don't count this script

    }

	#printf "251 Got clients=%d servers=%d\n", ($result{'clients'} || -1), ($result{'servers'} || -1);

}

#irc_252:  'moo.us.p2p-network.net' '18 :operator(s) online' [18, operator(s) online]

# opers

sub irc_252 {

    my $sender = $_[SENDER];

    my $irc = $sender->get_heap();

	my $s = $_[ARG1];

    #print "In 252: $s\n";

    if($s =~  /^(\d+)/) {

		$result{'opers'} = $1;

    }

	#printf "254 Got channels %d\n", ($result{'channels'} || -1);

}

#irc_253:  'moo.us.p2p-network.net' '1 :unknown connection(s)' [1, unknown connection(s)]

sub irc_253 {

    my $sender = $_[SENDER];

    my $irc = $sender->get_heap();

	my $s = $_[ARG1];

    #print "In 253: $s\n";

    if($s =~  /^(\d+)/) {

		$result{'unknownconns'} = $1;

    }

	#printf "254 Got channels %d\n", ($result{'channels'} || -1);

}

#irc_254:  'moo.us.p2p-network.net' '1325 :channels formed' [1325, channels formed]

# luserchannels

sub irc_254 {

    my $sender = $_[SENDER];

    my $irc = $sender->get_heap();

	my $s = $_[ARG1];

    #print "In 254: $s\n";

    if($s =~  /^(\d+)/) {

		$result{'channels'} = $1;

    }

	#printf "254 Got channels %d\n", ($result{'channels'} || -1);

}

#irc_255:  'moo.us.p2p-network.net' 'I have 348 clients and 1 servers' [I have 348 clients and 1 servers]

# local clients/servers

sub irc_255 {

    my $sender = $_[SENDER];

    my $irc = $sender->get_heap();

	my $s = $_[ARG1];

    #print "In 255: $s\n";

	if($s =~  /I have (\d+) clients and (\d+) servers/) {

		$result{'localclients'} = $1-1; # don't count this script

		$result{'localservers'} = $2;

	}

}

#irc_265:  'moo.us.p2p-network.net' 'Current Local Users: 348  Max: 1900' [Current Local Users: 348  Max: 1900]

sub irc_265 {

    #print "In 265\n";

    my $sender = $_[SENDER];

    my $irc = $sender->get_heap();

	my $s = $_[ARG1];

    #print "In 265: $s\n";

	if($s =~  /Current Local Users: (\d+)\s+Max: (\d+)/) {

		$result{'localclients'} = $1-1; # don't count this script

		$result{'localclientmax'} = $2;

	}

}

#irc_266:  'moo.us.p2p-network.net' 'Current Global Users: 3552  Max: 8742' [Current Global Users: 3552  Max: 8742]

sub irc_266 {

    #print "In 266\n";

	my $sender = $_[SENDER];

    my $irc = $sender->get_heap();

	my $s = $_[ARG1];

    #print "In 266: $s\n";

	if($s =~  /Current Global Users: (\d+)\s+Max: (\d+)/) {

		$result{'clients'} = $1-1; # don't count this script

		$result{'clientmax'} = $2;

	}

}

# 372 motdline

sub irc_372 {

	return;

}

# 375 startofmotd

sub irc_375 {

	return;

}

# 376 endofmotd

sub irc_376 {

    my $sender = $_[SENDER];

    my $irc = $sender->get_heap();

	$irc->yield( quit => {} );

}

sub munin_print {

	my $key = shift;

	my $val = shift;

	print "${key}.value ".($val || 'U')."\n";

}

sub irc_disconnected {

	for my $var (qw(clients channels servers localclients clientmax localclientmax localservers opers unknownconns)) {

		munin_print($var, $result{$var});

	}

	exit 0;

}

sub irc_public {

    my ($sender, $who, $where, $what) = @_[SENDER, ARG0 .. ARG2];

    my $nick = ( split /!/, $who )[0];

    my $channel = $where->[0];

    if ( my ($rot13) = $what =~ /^rot13 (.+)/ ) {

        $rot13 =~ tr[a-zA-Z][n-za-mN-ZA-M];

        $irc->yield( privmsg => $channel => "$nick: $rot13" );

    }

    return;

}

# We registered for all events, this will produce some debug info.

sub _default {

    my ($event, $args) = @_[ARG0 .. $#_];

    my @output = ( "$event: " );

    for my $arg (@$args) {

        if ( ref $arg eq 'ARRAY' ) {

            push( @output, '[' . join(', ', @$arg ) . ']' );

        }

        else {

            push ( @output, "'$arg'" );

        }

    }

    print join ' ', @output, "\n";

    return 0;

}