#!/usr/bin/perl -w
=head1 NAME
rrdupdate.pl - update/create RRDs on the fly using Spread
=head1 SYNOPSIS
rrdupdate -c `pwd`/rrdupdate.cfg
=head1 DESCRIPTION
It is a example OK!
You send it lines of input via the 'polling-rrd' group/mbox
Each line looks like
hostname:epochtime:state:pl:rtta:rttm
where:
hostname is the name of a host
epochtime is the oupit of time()
state is some number from 0 -> 15
pl is a packet loss 0 -> 100
rtta is a round-trip ping time
rttm is the max round-trip time
Like this:
zz-2468-OP-0805-02:1145857074:15:0:158:160
zz-2640-OP-0805-05:1145857074:15:0:153:185
zz-2556-GG-2924-01:1145857074:15:0:53.4:86.6
zz-2191-GG-2924-01:1145857074:15:0:14.7:47.5
zz-48GE-02-2924-01:1145857074:15:0:8.45:37.2
zz-6519-GG-2924-01:1145857074:15:0:89.0:124
zz-2247O-GG-2924-01:1145857074:15:0:20.2:57.7
zz-3627-GG-2924-01:1145857074:15:0:38.0:72.3
zz-3262-GG-2924-01:1145857074:15:0:37.3:42.7
zz-4114-GG-2924-01:1145857074:15:0:29.2:51.8
=head1 SEE ALSO
Spread and Spread::Message
cheers
markp
Mon Jul 14 15:20:47 EST 2003
=cut
require 5.0; # To make sure we only run under perl 5.0
use strict; # To generate all manner of warning's about poor code
use Utils; # Utility subs
use RRDs;
use Spread::Message;
$|=1;
# Variables we're going to use
my(
$Program_Name, # The name of the program running
$Version, # What version we are upto
);
@_ = split(/\/+/, $0);
$Program_Name = pop(@_);
$Version = '1.0';
###########################################################################
# Usage
#
# We need it here to get config file
#
my $Usage = <<ENDUSAGE;
Usage:
$Program_Name -c configfile
-c Configuration file
-d go into debug mode (ie dont do anything)
ENDUSAGE
use vars qw/ $opt_c $opt_d/;
use Getopt::Std;
unless (getopts('dc:'))
{
print $Usage;
exit 1;
}
unless ($opt_c)
{
print $Usage;
exit 1;
}
###########################################################################
# Ok now read in user config variables. They go into package Settings
# just for saftey ;-)
my $configfile = $opt_c;
my $debug = 0;
$debug++ if $opt_d;
read_config_file($configfile) || die;
$debug++ if defined $Settings::state{'Debug'} && $Settings::state{'Debug'} > 0;
# for when we re-exec ourselves
$Settings::state{'ConfigFile'} = $configfile;
chomp($Settings::state{'StartTime'} = `date`);
forkit() unless $opt_d;
my $name = "rrd$$";
my $mbox = Spread::Message->new(
spread_name => '4803@localhost',
name => $name,
group => ['polling-rrd'],
logto => ['nms-log'],
debug => 0,
member_sub => \&process_control,
message_sub => \&process_data,
timeout_sub => \&heartbeat,
);
$mbox->connect || die "Can't connect to spread daemon";
while(1)
{
$mbox->rx(20);
}
$mbox->disconnect();
exit;
sub heartbeat
{
my $mbox = shift;
# We don't see this but others do
$mbox->logit("waited 20s for RRD data\n");
}
sub process_control
{
my $mbox = shift;
}
sub process_data
{
my $mbox = shift;
my $loop = shift;
return unless $mbox->new_msg;
return unless grep(/^polling-rrd/,$mbox->grps);
rrdupdate($mbox);
}
sub rrdupdate
{
my($mbox) = shift;
my $count = 0;
my $tm = time;
for my $line (split(/\n/,$mbox->msg) )
{
my($host,$tm,$state,$pl,$rta,$rtm) = split(/:/,$line);
# my $rrdbase = $Settings::state{'rrddir'}."/$host";
my $rrdbase = rrddir($host);
rrdcreate($mbox,$host,$tm-1) unless -e "$rrdbase-state.rrd";
return unless -e "$rrdbase-state.rrd";
# First the Packet Loss, RTA stuff
my $rrd = $rrdbase."-ping.rrd";
RRDs::update ($rrd,"$tm:$tm:$pl:$rta:$rtm");
my $ERR=RRDs::error;
$mbox->logit("ERROR while updating $rrd: $ERR\n") if $ERR;
# Now the state information
$rrd = $rrdbase."-state.rrd";
RRDs::update ($rrd,"$tm:$tm:$state");
$ERR=RRDs::error;
$mbox->logit("ERROR while updating $rrd: $ERR\n") if $ERR;
$count += 2;
}
my $delay = time - $tm;
my $txt = "Updated $count RRD files in $delay seconds\n";
print $txt;
$mbox->logit($txt);
}
# Compute a directory for holding RRDs
sub rrddir
{
my $host = shift;
my $pre = substr($host,0,1);
return $Settings::state{'rrddir'}."/$pre/$host";
}
sub rrdcreate
{
my $mbox = shift;
my $host = shift;
my $start = shift;
#my $rrdbase = $Settings::state{'rrddir'}."/$host";
my $rrdbase = rrddir($host);
my $dir = $rrdbase;
$dir =~ s%/[^/]+$%%; # remove filename
mkdir $dir unless -d $dir;
# 25hrs @ 60s
# 1month @ 10min
# 1 year @ 1hrs
# About 583k per DB equals about 3G for 5000 devices
# Note: STATE is special. A hack in rrdtool-1.0.33.tar.gz by yours
# trully :-)
my $rrd = $rrdbase."-ping.rrd";
RRDs::create ($rrd, "--start", $start, "--step", 60,
'DS:time:GUAGE:600:0:U',
'DS:pl:GUAGE:600:0:U',
'DS:arta:GUAGE:600:U:U',
'DS:mrtt:GUAGE:600:U:U',
'RRA:GUAGE:0.999:1:9000',
'RRA:MAX:0.999:10:5040', # Want MAX values in CF
'RRA:MAX:0.999:60:9000', # Want MAX values in CF
);
my $ERROR = RRDs::error;
$mbox->logit("ERROR unable to create '$rrd': $ERROR\n") if $ERROR;
$rrd = $rrdbase."-state.rrd";
RRDs::create ($rrd, "--start", $start, "--step", 60,
'DS:time:GUAGE:600:0:U',
'DS:state:GUAGE:600:U:U',
'RRA:STATE:0.999:1:9000',
'RRA:STATE:0.999:10:5040', # Want last state in CF
'RRA:STATE:0.999:60:9000', # Want last state in CF
);
$ERROR = RRDs::error;
$mbox->logit("ERROR unable to create '$rrd': $ERROR\n") if $ERROR;
}
=head1 Copyright
Copyright 2003-2006, Mark Pfeiffer
This code may be copied only under the terms of the Artistic License
which may be found in the Perl 5 source kit.
Use 'perldoc perlartistic' to see the Artistic License.
Complete documentation for Perl, including FAQ lists, should be found on
this system using `man perl' or `perldoc perl'. If you have access to the
Internet, point your browser at http://www.perl.org/, the Perl Home Page.
=cut