ossp-pkg/flow2rrd/flow2rrd.pl
#!@PERL@
##
## OSSP flow2rrd -- NetFlow to Round-Robin Database
## Copyright (c) 2004 Ralf S. Engelschall <rse@engelschall.com>
## Copyright (c) 2004 The OSSP Project <http://www.ossp.org/>
##
## This file is part of OSSP flow2rrd, a tool for storing NetFlow data
## into an RRD which can be found at http://www.ossp.org/pkg/tool/flow2rrd/.
##
## This program is free software; you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
## the Free Software Foundation; either version 2 of the License, or
## (at your option) any later version.
##
## This program is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
## General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with this program; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
## USA, or contact Ralf S. Engelschall <rse@engelschall.com>.
##
## flow2rrd.pl: program (language: Perl)
##
require 5.008;
use strict;
$|++;
# external requirements
use POSIX; # from OpenPKG "perl"
use IO::File; # from OpenPKG "perl"
use Getopt::Long; # from OpenPKG "perl"
use Time::Local; # from OpenPKG "perl"
use File::Temp; # from OpenPKG "perl"
use Data::Dumper; # from OpenPKG "perl"
use Date::Parse; # from OpenPKG "perl-time"
use Net::Patricia; # from OpenPKG "perl-net"
use String::Divert; # from OpenPKG "perl-text"
use OSSP::cfg; # from OpenPKG "cfg" [with_perl=yes]
use Cflow qw(); # from OpenPKG "flowtools" [with_perl=yes]
use RRDs; # from OpenPKG "rrdtools"
use CGI; # from OpenPKG "perl-www"
# Data::Dumper configuration
$Data::Dumper::Purity = 1;
$Data::Dumper::Indent = 1;
$Data::Dumper::Terse = 1;
# fixed program information
my $my = {
-progname => 'OSSP flow2rrd',
-proghome => 'http://www.ossp.org/pkg/tool/flow2rrd/',
-progvers => '@VERSION@',
};
# run-time options
my $opt = {
-help => 0,
-version => 0,
-config => '@SYSCONFDIR@/flow2rrd.cfg',
-store => 0,
-graph => 0,
-cgi => (($ENV{'GATEWAY_INTERFACE'} || "") eq 'CGI/1.1' ? 1 : 0)
};
# parse command line options
Getopt::Long::Configure("bundling");
my %getopt_spec = (
'h|help' => \$opt->{-help},
'v|version' => \$opt->{-version},
'V|verbose' => \$opt->{-verbose},
'f|config=s' => \$opt->{-config},
's|store' => \$opt->{-store},
'g|graph' => \$opt->{-graph},
'c|cgi' => \$opt->{-cgi},
);
my $result = GetOptions(%getopt_spec)
or die "command line option parsing failed";
if ($opt->{help}) {
print "usage: $my->{-progname} [<options>] <hostname>\n" .
"available options are:\n" .
" -h,--help print out this usage page\n" .
" -v,--version print program version\n" .
" -V,--verbose print verbose messages\n" .
" -f,--config FILE read this configuration file only\n" .
" -s,--store store NetFlow values into RRD\n" .
" -g,--graph produce RRD graphs\n" .
" -c,--cgi produce Web user interface\n";
exit(0);
}
if ($opt->{-version}) {
print "$my->{-progname} $my->{-progvers}\n";
exit(0);
}
if (not $opt->{-store} and not $opt->{-graph} and not $opt->{-cgi}) {
die "either --store, --graph or --cgi option has to be given";
}
if (($opt->{-store} or $opt->{-graph}) and $opt->{-cgi}) {
die "option --cgi cannot be combined with --store or --graph";
}
# read configuration file
my $io = new IO::File "<$opt->{-config}"
or die "unable to read configuration file \"$opt->{-config}\"";
my $txt; { local $/; $txt = <$io>; }
$io->close();
# parse configuration files
my $cs = new OSSP::cfg::simple;
$cs->parse($txt);
my $tree = $cs->unpack();
undef $cs;
#print Data::Dumper->Dump([$tree]);
# extract configuration elements
my $cfg = {
'Database' => {},
'Host' => [],
'Protocol' => {},
'Service' => {},
'Colors' => {},
};
foreach my $dir (@{$tree}) {
if ($dir->[0] eq 'Database') {
die "Database already defined" if (defined($cfg->{'Database'}->{-file}));
$cfg->{'Database'}->{-file} = $dir->[1];
my $seq = $dir->[2];
foreach my $dir2 (@{$seq}) {
if ($dir2->[0] eq 'Stepping') {
$cfg->{'Database'}->{-step} = $dir2->[1];
}
elsif ($dir2->[0] eq 'Storage') {
my $s = [];
foreach my $spec (@{$dir2}[1..$#{$dir2}]) {
if (my ($res, $dur) = ($spec =~ m/^(\S+):(\S+)$/)) {
push(@{$s}, { -res => $res, -dur => $dur});
}
else {
die "invalid storage specification \"$spec\"";
}
}
$cfg->{'Database'}->{-storage} = $s;
}
}
}
elsif ($dir->[0] eq 'Protocol') {
die "Protocol \"$dir->[1]\" already defined" if (defined($cfg->{'Protocol'}->{$dir->[1]}));
die "invalid protocol number \"$dir->[2]\"" if ($dir->[2] !~ m|^\d+$|);
$cfg->{'Protocol'}->{$dir->[1]} = $dir->[2];
}
elsif ($dir->[0] eq 'Service') {
die "Service \"$dir->[1]\" already defined" if (defined($cfg->{'Service'}->{$dir->[1]}));
my $s = [];
foreach my $spec (@{$dir}[2..$#{$dir}]) {
if (my ($proto, $port) = ($spec =~ m/^(\S+):(\d+|\*)$/)) {
die "invalid protocol number \"$proto\""
if (not ($proto =~ m|^\d+$| or defined($cfg->{'Protocol'}->{$proto})));
push(@{$s}, { -proto => $proto, -port => $port});
}
else {
die "invalid service specification \"$spec\"";
}
}
$cfg->{'Service'}->{$dir->[1]} = $s;
}
elsif ($dir->[0] eq 'Host') {
my $h = {
-name => $dir->[1],
-target => { -order => [] },
};
my $seq = $dir->[2];
foreach my $dir2 (@{$seq}) {
if ($dir2->[0] eq 'Target') {
my $t = { -network => [], -service => [] };
my $seq2 = $dir2->[2];
foreach my $dir3 (@{$seq2}) {
if ($dir3->[0] eq 'Network') {
$t->{-network} = [ @{$dir3}[1..$#{$dir3}] ];
}
elsif ($dir3->[0] eq 'Service') {
$t->{-service} = [ @{$dir3}[1..$#{$dir3}] ];
}
else {
die "invalid configuration directive \"$dir3->[0]\"";
}
}
$h->{-target}->{$dir2->[1]} = $t;
push(@{$h->{-target}->{-order}}, $dir2->[1]);
}
else {
die "invalid configuration directive \"$dir2->[0]\"";
}
}
push(@{$cfg->{'Host'}}, $h);
}
elsif ($dir->[0] eq 'Colors') {
die "Colors \"$dir->[1]\" already defined" if (defined($cfg->{'Colors'}->{$dir->[1]}));
my $c = [];
my $last = 0x000000;
foreach my $spec (@{$dir}[2..$#{$dir}]) {
my $this;
if ($spec =~ m|^[\da-fA-F]{6}$|) {
push(@{$c}, $spec);
$last = $spec;
}
elsif ($spec =~ m|^([-+])([\da-fA-F]{6})(?:\((\d+)\))?$|) {
my ($op, $color, $repeat) = ($1, $2, $3);
$repeat = 1 if (not defined($repeat));
for (my $i = 0; $i < $repeat; $i++) {
my $this; eval "\$this = sprintf(\"%06x\", (0x$last $op 0x$color) % 0xffffff)";
push(@{$c}, $this);
$last = $this;
}
}
else {
die "invalid color specification \"$spec\"";
}
}
$cfg->{'Colors'}->{$dir->[1]} = $c;
}
else {
die "invalid configuration directive \"$dir->[0]\"";
}
}
#print Data::Dumper->Dump([$cfg]);
# hostname/target/service to 15 chars RRD DS name mapping
my $rrd_ds_name_cache = {};
sub make_rrd_ds_name {
my ($host, $target, $service) = @_;
my $ds_name = $rrd_ds_name_cache->{$host.$target.$service};
if (not defined($ds_name)) {
$host =~ s|[^a-zA-Z0-9_-]||sg;
$host = substr($host . ("_"x5), 0, 5);
$target =~ s|[^a-zA-Z0-9_-]||sg;
$target = substr($target . ("_"x5), 0, 5);
$service =~ s|[^a-zA-Z0-9_-]||sg;
$service = substr($service . ("_"x5), 0, 5);
$ds_name = sprintf("%s_%s_%s", $host, $target, $service);
$rrd_ds_name_cache->{$host.$target.$service} = $ds_name;
}
return $ds_name;
}
# conversion/canonicalization of time specifications
sub cv_time {
my ($t) = @_;
if ($t =~ m|^now(.*)$|) {
$t = time() + &cv_time($1);
}
elsif ($t =~ m|^([-+])(.+)$|) {
$t = &cv_time($2);
eval "\$t = $1 \$t";
}
elsif ($t =~ m|(\d{2})-([A-Za-z]{3})-(\d{4})|) {
$t = str2time($t);
}
elsif ($t =~ m|^([\d.]+)([smhDWMY])$|) {
$t = $1;
if ($2 eq 's') { $t *= 1; }
elsif ($2 eq 'm') { $t *= 60; }
elsif ($2 eq 'h') { $t *= 60*60; }
elsif ($2 eq 'D') { $t *= 24*60*60; }
elsif ($2 eq 'W') { $t *= 7*24*60*60; }
elsif ($2 eq 'M') { $t *= 30*24*60*60; }
elsif ($2 eq 'Y') { $t *= 365*24*60*60; }
}
elsif ($t =~ m|^([\d.]+)$|) {
$t = $1;
}
else {
$t = 0;
}
return $t;
}
# conversion/canonicalization of limit specifications
sub cv_limit {
my ($l) = @_;
if ($l eq '') {
$l = 0;
}
elsif ($l =~ m|^([-+])(.*)$|) {
$l = &cv_limit($2);
eval "\$l = $1 \$l";
}
elsif ($l =~ m|^(\d+)([KMGT])$|) {
$l = $1;
if ($2 eq 'K') { $l *= 1024; }
if ($2 eq 'M') { $l *= 1024*1024; }
if ($2 eq 'G') { $l *= 1024*1024*1024; }
if ($2 eq 'T') { $l *= 1024*1024*1024*1024; }
}
return $l;
}
##
## ==== OPERATION MODE 1: STORE DATA ====
##
if ($opt->{-store}) {
my $step = &cv_time($cfg->{'Database'}->{-step});
# initialize data
my $ctx = &data_init($cfg);
# scan flow-tools stream on STDIN for NetFlow records
my $flows = 0;
my $tick = 0;
my $ticktick = 0;
my $done = 0;
my @done = ();
Cflow::verbose(0);
Cflow::find(sub { &foreach_record($cfg, $ctx) }, "-");
sub foreach_record {
my ($cfg, $ctx) = @_;
# at start of time slot, load accumulated data
if (not defined($ctx->{-endtime})) {
# initial setup, so initialize time slot tracking
$ctx->{-starttime} = int($Cflow::endtime / $step) * $step;
$ctx->{-endtime} = $ctx->{-starttime} + $step;
# load data
&rrd_load($cfg, $ctx);
}
# at end of time slot, store accumulated data
if ($Cflow::endtime >= $ctx->{-endtime}) {
# store data
&rrd_store($cfg, $ctx);
# step one time slot forward
$ctx->{-starttime} = $ctx->{-endtime};
$ctx->{-endtime} += $step;
}
# accumulate data
&data_accumulate($cfg, $ctx);
# statistics
if ($opt->{-verbose}) {
$flows++;
$done++;
$ticktick++;
my $tick_new = ($ticktick > 1000 ? time() : 0);
if ($tick < $tick_new) {
push(@done, $done);
shift(@done) if (@done > 20);
my $sum = 0; map { $sum += $_ } @done; $sum /= scalar(@done);
printf(STDERR "Storing: %10d flows, %6.1f flows/sec (average: %6.1f flows/sec)\r", $flows, $done, $sum);
$tick = $tick_new;
$done = 0;
}
}
}
&rrd_store($cfg, $ctx);
# initialize data tracking context
sub data_init {
my ($cfg) = @_;
# create tracking context
my $ctx = {
-starttime => 0,
-endtime => undef,
-track => {},
-network => {},
};
foreach my $host (@{$cfg->{'Host'}}) {
foreach my $target (grep { $_ !~ m/^-/ } keys(%{$host->{-target}})) {
my $np = new Net::Patricia;
foreach my $network (@{$host->{-target}->{$target}->{-network}}) {
$np->add_string($network, 1);
}
$ctx->{-network}->{$host->{-name}.":".$target} = $np;
foreach my $service (@{$host->{-target}->{$target}->{-service}}) {
my $ds_name = &make_rrd_ds_name($host->{-name}, $target, $service);
$ctx->{-track}->{"${ds_name}_i"} = 0;
$ctx->{-track}->{"${ds_name}_o"} = 0;
}
}
}
return $ctx;
}
# create RRD file (if still not existing)
sub rrd_create {
my ($cfg, $time) = @_;
return if (-f $cfg->{'Database'}->{-file});
# determine RRD data sources (DS)
my @ds = ();
foreach my $host (@{$cfg->{'Host'}}) {
foreach my $target (grep { $_ !~ m/^-/ } keys(%{$host->{-target}})) {
foreach my $service (@{$host->{-target}->{$target}->{-service}}) {
my $ds_name = &make_rrd_ds_name($host->{-name}, $target, $service);
push(@ds, "DS:${ds_name}_i:ABSOLUTE:600:0:U");
push(@ds, "DS:${ds_name}_o:ABSOLUTE:600:0:U");
}
}
}
push(@ds, "DS:UNKNOWN:ABSOLUTE:600:0:U");
# determine RRD archive (RRA)
my @rra = ();
sub mkrra {
my ($step, $res, $duration) = @_;
my $steps = int($res / $step);
my $rows = int($duration / $res);
my $rra = sprintf('RRA:LAST:0:%d:%d', $steps, $rows);
push(@rra, $rra);
}
foreach my $s (@{$cfg->{'Database'}->{-storage}}) {
my $res = &cv_time($s->{-res});
my $dur = &cv_time($s->{-dur});
&mkrra($step, $res, $dur);
}
# create RRD database
RRDs::create($cfg->{'Database'}->{-file}, '--start', $time, '--step', $step, @ds, @rra);
my $err = RRDs::error();
die "failed to create RRD file: $err" if (defined($err));
}
# load already stored accumulated data of current time slot back from RRD
sub rrd_load {
my ($cfg, $ctx) = @_;
# make sure the RRD is available
&rrd_create($cfg, $Cflow::endtime);
# load data from RRD
my ($rrd_start, $rrd_step, $rrd_names, $rrd_data) = RRDs::fetch(
$cfg->{'Database'}->{-file},
'LAST',
'--resolution', $step,
'--start', $ctx->{-endtime},
'--end', $ctx->{-endtime}
);
my $err = RRDs::error();
if (not defined($err) and defined($rrd_names) and defined($rrd_data)) {
for (my $i = 0; $i <= $#{$rrd_names}; $i++) {
my $ds_name = $rrd_names->[$i];
my $ds_value = $rrd_data->[0]->[$i] || 0;
$ctx->{-track}->{$ds_name} = $ds_value;
}
}
}
# accumulate data
sub data_accumulate {
my ($cfg, $ctx) = @_;
# iterate over all target and services to see whether
# the flow matches them...
my $matched_total = 0;
LOOP:
foreach my $host (@{$cfg->{'Host'}}) {
foreach my $target (@{$host->{-target}->{-order}}) {
my $inbound;
my $np = $ctx->{-network}->{$host->{-name}.":".$target};
if ($np->match_string($Cflow::srcip)) { $inbound = 0; }
elsif ($np->match_string($Cflow::dstip)) { $inbound = 1; }
if (defined($inbound)) {
foreach my $service (@{$host->{-target}->{$target}->{-service}}) {
foreach my $s (@{$cfg->{'Service'}->{$service}}) {
if ($Cflow::protocol == $cfg->{'Protocol'}->{$s->{-proto}}) {
my $port = $s->{-port};
if ( $port eq '*'
or (( $inbound and $port == $Cflow::dstport)
or (not $inbound and $port == $Cflow::srcport))) {
# flow matched target/service, so accumulate data
my $ds_name = &make_rrd_ds_name($host->{-name}, $target, $service);
if ($inbound) { $ctx->{-track}->{"${ds_name}_i"} += $Cflow::bytes; }
else { $ctx->{-track}->{"${ds_name}_o"} += $Cflow::bytes; }
$matched_total++;
last LOOP;
}
}
}
}
}
}
}
if ($matched_total == 0) {
$ctx->{-track}->{"UNKNOWN"} += $Cflow::bytes;
}
}
# store accumulated data into RRD
sub rrd_store {
my ($cfg, $ctx) = @_;
# make sure the RRD is available
&rrd_create($cfg, $Cflow::endtime);
# store data to RRD
my $ds_list = '';
my $dv_list = '';
my $i = 0;
foreach my $ds_name (sort(keys(%{$ctx->{-track}}))) {
# generate update argument
$ds_list .= ($ds_list ne '' ? ":" : "") . $ds_name;
$dv_list .= ($dv_list ne '' ? ":" : "") . $ctx->{-track}->{$ds_name};
# reset value
$ctx->{-track}->{$ds_name} = 0;
}
RRDs::update(
$cfg->{'Database'}->{-file},
'--template', $ds_list,
sprintf("%d", $ctx->{-endtime}).":".$dv_list
);
my $err = RRDs::error();
warn "failed to store data to RRD file: $err" if (defined($err));
}
}
##
## ==== OPERATION MODE 2: GENERATE GRAPHS ====
##
if ($opt->{-graph}) {
if (@ARGV == 0) {
die "missing graph specifications";
}
foreach my $spec (@ARGV) {
# determine graph parameters
$spec =~ m/^(.+)\@(\S+):(\d+):(\d+):([^:]+):([^:]+):([^:]+):([^:]+)$/
or die "invalid graph specification \"$spec\" (expect <content>:<file>:<width>:<height>:<start>:<end>:<ulimit>:<llimit>)";
my ($content, $img_file, $img_width, $img_height) = ($1, $2, $3, $4);
my ($graph_start, $graph_end, $graph_ulimit, $graph_llimit) = ($5, $6, $7, $8);
# post-process parameters
my $img_format = ($img_file =~ m|\.png$| ? "PNG" : "GIF");
if ($graph_start =~ m/^\-(.+)/) {
$graph_end = &cv_time($graph_end);
$graph_start = $graph_end - &cv_time($1);
}
elsif ($graph_end =~ m/^\+(.+)/) {
$graph_start = &cv_time($graph_start);
$graph_end = $graph_start + &cv_time($1);
}
else {
$graph_start = &cv_time($graph_start);
$graph_end = &cv_time($graph_end);
}
$graph_ulimit = &cv_limit($graph_ulimit);
$graph_llimit = &cv_limit($graph_llimit);
my $graph = {
-img_file => $img_file,
-img_format => $img_format,
-img_width => $img_width,
-img_height => $img_height,
-graph_start => $graph_start,
-graph_end => $graph_end,
-graph_ulimit => $graph_ulimit,
-graph_llimit => $graph_llimit,
};
if ($content =~ m|^(\S+):(\S+)$|) {
&make_graph_target($graph, $1, $2);
}
else {
&make_graph_host($graph, $content);
}
# generate graph for a host
sub make_graph_host {
my ($graph, $hostname) = @_;
# find host configuration record
my $host; $host = undef;
foreach my $h (@{$cfg->{'Host'}}) {
if ($h->{-name} eq $hostname) {
$host = $h;
last;
}
}
if (not defined($host)) {
die "host \"$hostname\" not found";
}
my $colors = $cfg->{'Colors'}->{'colorful'}; # FIXME
my @def = ();
my @cdef = ();
my @draw_o = ();
my @draw_i = ();
my $i = 0;
my $cols = 1;
$cols = 2 if ($graph->{-img_width} >= 200);
$cols = 3 if ($graph->{-img_width} >= 400);
$cols = 4 if ($graph->{-img_width} >= 600);
$cols = 5 if ($graph->{-img_width} >= 800);
# FIXME: UNKNOWN data?
my $data_i = '';
my $data_o = '';
foreach my $target (@{$host->{-target}->{-order}}) {
my $cdef_i = '';
my $cdef_o = '';
foreach my $service (@{$host->{-target}->{$target}->{-service}}) {
my $ds_name = &make_rrd_ds_name($host->{-name}, $target, $service);
push(@def, sprintf("DEF:%s_o=%s:%s_o:LAST", $ds_name, $cfg->{'Database'}->{-file}, $ds_name));
push(@def, sprintf("DEF:%s_i=%s:%s_i:LAST", $ds_name, $cfg->{'Database'}->{-file}, $ds_name));
$cdef_o = ($cdef_o eq '' ? "${ds_name}_o" : "${ds_name}_o,$cdef_o,+");
$cdef_i = ($cdef_i eq '' ? "${ds_name}_i" : "${ds_name}_i,$cdef_i,+");
}
$cdef_o .= ",8,*";
$cdef_i .= ",8,*";
$cdef_i .= ",-1,*";
push(@cdef, sprintf("CDEF:data%d_o=%s", $i, $cdef_o));
push(@cdef, sprintf("CDEF:data%d_i=%s", $i, $cdef_i));
my $color_o; eval "\$color_o = 0x".$colors->[$i];
my $color_i; eval "\$color_i = \$color_o - 0x101010";
push(@draw_o, sprintf("GPRINT:data%d_o:AVERAGE:%%4.0lf%%S", $i));
push(@draw_o, sprintf("%s:data%d_o#%06x:out %s", ($i == 0 ? "AREA" : "STACK"), $i, $color_o, sprintf("%-8s", substr($target, 0, 8))));
push(@draw_o, 'COMMENT:\n') if ($i % $cols == ($cols-1));
push(@draw_i, sprintf("GPRINT:data%d_i:AVERAGE:%%4.0lf%%S", $i));
push(@draw_i, sprintf("%s:data%d_i#%06x:in %s", ($i == 0 ? "AREA" : "STACK"), $i, $color_i, sprintf("%-8s", substr($target, 0, 8))));
push(@draw_i, 'COMMENT:\n') if ($i % $cols == ($cols-1));
$data_o = ($data_o eq '' ? sprintf("data%d_o", $i) : sprintf("data%d_o,%s,+", $i, $data_o));
$data_i = ($data_i eq '' ? sprintf("data%d_i", $i) : sprintf("data%d_i,%s,+", $i, $data_i));
$i++;
}
push(@cdef, sprintf("CDEF:data_o=%s", $data_o));
push(@cdef, sprintf("CDEF:data_i=%s", $data_i));
my @draw = (@draw_o, 'COMMENT:\n', @draw_i);
push(@draw, 'COMMENT:\n');
push(@draw, 'COMMENT:\n');
push(@draw, sprintf("GPRINT:data_o:AVERAGE:Total Average Traffic\\: %%.0lf%%S out /"));
push(@draw, sprintf("GPRINT:data_i:AVERAGE:%%.0lf%%S in"));
push(@draw, "HRULE:0#000000");
my $now = time();
my $tzoffset = $now - timelocal(gmtime($now));
my $ts = int(($graph->{-graph_start} / (24*60*60)) + 0) * (24*60*60);
my $te = int(($graph->{-graph_end} / (24*60*60)) + 1) * (24*60*60);
for (my $t = $ts; $t < $te; $t += (12*60*60)) {
if (($t % (24*60*60)) == 0) { push(@draw, sprintf("VRULE:%d#000000", $t - $tzoffset)); }
else { push(@draw, sprintf("VRULE:%d#999999", $t - $tzoffset)); }
}
my @args = ();
push(@args, $graph->{-img_file});
push(@args, '--imgformat', $graph->{-img_format});
push(@args, '--width', $graph->{-img_width});
push(@args, '--height', $graph->{-img_height});
push(@args, '--start', $graph->{-graph_start});
push(@args, '--end', $graph->{-graph_end});
push(@args, '--upper-limit', $graph->{-graph_ulimit}) if ($graph->{-graph_ulimit} != 0);
push(@args, '--lower-limit', $graph->{-graph_llimit}) if ($graph->{-graph_llimit} != 0);
push(@args, '--rigid');
push(@args, '--alt-autoscale');
push(@args, '--base', 1024);
push(@args, '--x-grid', "HOUR:1:DAY:1:DAY:1:0:%d-%b-%Y");
push(@args, '--vertical-label', 'Bit/s');
push(@args, '--color', 'CANVAS#f0f0ff');
push(@args, '--color', 'BACK#e0e0f0');
push(@args, '--color', 'SHADEA#e5e5f5');
push(@args, '--color', 'SHADEB#d0d0e0');
push(@args, '--color', 'GRID#cccccc');
push(@args, '--color', 'MGRID#999999');
push(@args, '--color', 'FONT#000000');
push(@args, '--color', 'FRAME#000000');
push(@args, '--color', 'ARROW#000000');
push(@args, '--title', sprintf("Host %s (+out/-in)", $host->{-name}));
push(@args, @def);
push(@args, @cdef);
push(@args, @draw);
my ($rrd_averages, $rrd_xsize, $rrd_ysize) = &rrd_graph(@args);
my $err = RRDs::error();
die "failed to generate graph from RRD file: $err" if (defined($err));
}
# generate graph for a target
sub make_graph_target {
my ($graph, $hostname, $targetname) = @_;
# find host configuration record
my $host; $host = undef;
foreach my $h (@{$cfg->{'Host'}}) {
if ($h->{-name} eq $hostname) {
$host = $h;
last;
}
}
if (not defined($host)) {
die "host \"$hostname\" not found";
}
# find target configuration record
my $target; $target = undef;
foreach my $t (@{$host->{-target}->{-order}}) {
if ($t eq $targetname) {
$target = $t;
last;
}
}
if (not defined($target)) {
die "target \"$targetname\" not found";
}
my $colors = $cfg->{'Colors'}->{'colorful'}; # FIXME
my @def = ();
my @cdef = ();
my @draw_o = ();
my @draw_i = ();
my $i = 0;
my $cols = 1;
$cols = 2 if ($graph->{-img_width} >= 200);
$cols = 3 if ($graph->{-img_width} >= 400);
$cols = 4 if ($graph->{-img_width} >= 600);
$cols = 5 if ($graph->{-img_width} >= 800);
my $data_i = '';
my $data_o = '';
foreach my $service (@{$host->{-target}->{$target}->{-service}}) {
my $ds_name = &make_rrd_ds_name($host->{-name}, $target, $service);
push(@def, sprintf("DEF:%s_o=%s:%s_o:LAST", $ds_name, $cfg->{'Database'}->{-file}, $ds_name));
push(@def, sprintf("DEF:%s_i=%s:%s_i:LAST", $ds_name, $cfg->{'Database'}->{-file}, $ds_name));
push(@cdef, sprintf("CDEF:data%d_o=%s_o,8,*,+1,*", $i, $ds_name));
push(@cdef, sprintf("CDEF:data%d_i=%s_i,8,*,-1,*", $i, $ds_name));
my $color_o; eval "\$color_o = 0x".$colors->[$i];
my $color_i; eval "\$color_i = \$color_o - 0x101010";
push(@draw_o, sprintf("GPRINT:data%d_o:AVERAGE:%%4.0lf%%s", $i));
push(@draw_o, sprintf("%s:data%d_o#%06x:out %s", ($i == 0 ? "AREA" : "STACK"), $i, $color_o, sprintf("%-8s", substr($service, 0, 8))));
push(@draw_o, 'COMMENT:\n') if ($i % $cols == ($cols-1));
push(@draw_i, sprintf("GPRINT:data%d_i:AVERAGE:%%4.0lf%%s", $i));
push(@draw_i, sprintf("%s:data%d_i#%06x:in %s", ($i == 0 ? "AREA" : "STACK"), $i, $color_i, sprintf("%-8s", substr($service, 0, 8))));
push(@draw_i, 'COMMENT:\n') if ($i % $cols == ($cols-1));
$data_o = ($data_o eq '' ? sprintf("data%d_o", $i) : sprintf("data%d_o,%s,+", $i, $data_o));
$data_i = ($data_i eq '' ? sprintf("data%d_i", $i) : sprintf("data%d_i,%s,+", $i, $data_i));
$i++;
}
push(@cdef, sprintf("CDEF:data_o=%s", $data_o));
push(@cdef, sprintf("CDEF:data_i=%s", $data_i));
my @draw = (@draw_o, 'COMMENT:\n', @draw_i);
push(@draw, 'COMMENT:\n');
push(@draw, 'COMMENT:\n');
push(@draw, sprintf("GPRINT:data_o:AVERAGE:Total Average Traffic\\: %%.0lf%%S out /"));
push(@draw, sprintf("GPRINT:data_i:AVERAGE:%%.0lf%%S in"));
push(@draw, "HRULE:0#000000");
my $now = time();
my $tzoffset = $now - timelocal(gmtime($now));
my $ts = int(($graph->{-graph_start} / (24*60*60)) + 0) * (24*60*60);
my $te = int(($graph->{-graph_end} / (24*60*60)) + 1) * (24*60*60);
for (my $t = $ts; $t < $te; $t += (12*60*60)) {
if (($t % (24*60*60)) == 0) { push(@draw, sprintf("VRULE:%d#000000", $t - $tzoffset)); }
else { push(@draw, sprintf("VRULE:%d#999999", $t - $tzoffset)); }
}
my @args = ();
push(@args, $graph->{-img_file});
push(@args, '--imgformat', $graph->{-img_format});
push(@args, '--width', $graph->{-img_width});
push(@args, '--height', $graph->{-img_height});
push(@args, '--start', $graph->{-graph_start});
push(@args, '--end', $graph->{-graph_end});
push(@args, '--upper-limit', $graph->{-graph_ulimit}) if ($graph->{-graph_ulimit} != 0);
push(@args, '--lower-limit', $graph->{-graph_llimit}) if ($graph->{-graph_llimit} != 0);
push(@args, '--rigid');
push(@args, '--alt-autoscale');
push(@args, '--base', 1024);
push(@args, '--x-grid', "HOUR:1:DAY:1:DAY:1:0:%d-%b-%Y");
push(@args, '--vertical-label', 'Bit/s');
push(@args, '--color', 'CANVAS#f0f0ff');
push(@args, '--color', 'BACK#e0e0f0');
push(@args, '--color', 'SHADEA#e5e5f5');
push(@args, '--color', 'SHADEB#d0d0e0');
push(@args, '--color', 'GRID#cccccc');
push(@args, '--color', 'MGRID#999999');
push(@args, '--color', 'FONT#000000');
push(@args, '--color', 'FRAME#000000');
push(@args, '--color', 'ARROW#000000');
push(@args, '--title', sprintf("Target %s on Host %s (+out/-in)", $target, $host->{-name}));
push(@args, @def);
push(@args, @cdef);
push(@args, @draw);
my ($rrd_averages, $rrd_xsize, $rrd_ysize) = &rrd_graph(@args);
my $err = RRDs::error();
die "failed to generate graph from RRD file: $err" if (defined($err));
}
# render an RRD graph (frontend to RRDs::graph() function)
sub rrd_graph {
my (@args) = @_;
my ($rrd_results, $rrd_xsize, $rrd_ysize);
# if no Y axis limits are specified, try to determine
# reasonable ones based on the calculated average values
# (instead of the maximum values RRDTool uses by default)
if (not grep { $_ =~ m/^--(?:upper|lower)-limit$/ } @args) {
my @a = @args;
@a = map { s/^GPRINT/PRINT/s; $_ }
grep { $_ !~ m/^(AREA|STACK|LINE|HRULE|VRULE):/ }
@a;
($rrd_results, $rrd_xsize, $rrd_ysize) = RRDs::graph(@a);
my $err = RRDs::error();
if (not defined($err)) {
my $print = join(" ", @{$rrd_results});
if ($print =~ m/Total Average Traffic:\s+(\S+)\s+out\s+\/\s+(\S+)\s+in/s) {
my ($ulimit, $llimit) = (&canon($1), &canon($2));
sub canon {
my ($limit) = @_;
if ($limit =~ m|^([+-]?\d+)k$|) { $limit = $1 * 1000; }
elsif ($limit =~ m|^([+-]?\d+)M$|) { $limit = $1 * 1000*1000; }
elsif ($limit =~ m|^([+-]?\d+)G$|) { $limit = $1 * 1000*1000*1000; }
return $limit;
}
$ulimit = int($ulimit * 1.5);
$llimit = int($llimit * 1.5);
push(@args, '--upper-limit', $ulimit);
push(@args, '--lower-limit', $llimit);
}
}
}
# pass through the arguments to the RRDs::graph() function
($rrd_results, $rrd_xsize, $rrd_ysize) = RRDs::graph(@args);
return ($rrd_results, $rrd_xsize, $rrd_ysize);
}
}
}
##
## ==== OPERATION MODE 3: GENERATE WEB USER INTERFACE ====
##
if ($opt->{-cgi}) {
my $cgi = new CGI;
# CGI error handler
$SIG{__DIE__} = sub {
my ($msg) = @_;
my $hint = '';
if ($msg =~ m|line\s+(\d+)|) {
my $line = $1;
my $io = new IO::File "<$0";
my @code = $io->getlines();
$io->close();
my $i = -1;
$hint = join("", map { s/^/sprintf("%d: ", $line+$i++)/se; $_; } @code[$line-2..$line]);
}
print STDOUT
"Content-Type: text/html; charset=ISO-8859-1\n" .
"\n" .
"<html>\n" .
" <head>\n" .
" <title>OSSP flow2rrd: ERROR</title>\n" .
" </head>\n" .
" <body>\n" .
" <h1>OSSP flow2rrd: ERROR</h1>\n" .
" <p>\n" .
" <tt>\n" .
" $msg<br>\n" .
" </tt>\n" .
" <pre>\n$hint</pre>\n" .
" </body>\n" .
"</html>\n";
exit(0);
};
if (defined($cgi->param("css"))) {
#
# output Cascading Style Sheet (CSS)
#
# define CSS content
my $css = q{
BODY {
background: #c0c0c0;
color: #ffffff;
font-family: helvetica,arial,tahoma,verdana,sans-serif;
}
TABLE.flow2rrd {
background: #000000;
border: 2px solid #000000;
}
TABLE.flow2rrd TD.header {
color: #ffffff;
font-family: tahoma,helvetica,arial,tahoma,verdana,sans-serif;
font-weight: bold;
font-size: 200%;
padding: 4px;
text-align: center;
}
TABLE.flow2rrd TD.header A {
text-decoration: none;
color: #ffffff;
}
TABLE.flow2rrd TD.footer {
color: #ffffff;
font-family: tahoma,helvetica,arial,tahoma,verdana,sans-serif;
padding: 4px;
text-align: center;
}
TABLE.flow2rrd TD.footer A {
text-decoration: none;
font-weight: bold;
color: #ffffff;
}
TABLE.flow2rrd TABLE.explore TD.toolbar {
background: #333333;
padding: 10px;
}
TABLE.flow2rrd TABLE.explore TD.toolbar INPUT.textfield {
background: #333333;
color: #ffffff;
border: 0px;
border-bottom: 1px solid #999999;
}
TABLE.flow2rrd TABLE.explore TD.toolbar INPUT.submit {
background: #666666;
color: #ffffff;
margin-top: 10px;
border: 1px solid #999999;
font-weight: bold;
width: 100%;
}
};
# send out CSS data
$css =~ s|^ ||mg;
print STDOUT $cgi->header(
-type => 'text/css',
-content_length => length($css),
-expires => '+5m'
) . $css;
}
elsif (defined(my $graph = $cgi->param("graph"))) {
#
# output graph image
#
# prepare graph generation
my (undef, $tmpfile) = mkstemp(($ENV{'TMPDIR'} || '/tmp') . "/flow2rrd.XXXXXX");
$graph =~ s|\@|\@$tmpfile:|s;
# generate graph image
my $rc = system("GATEWAY_INTERFACE=none $0 --config=\"$opt->{-config}\" --graph $graph");
if ($rc != 0 or not -s $tmpfile) {
die "failed to generate graph image: $!";
}
# read graph image
my $io = new IO::File "<$tmpfile" or die "cannot read graph";
my $data; { local $/; $data = <$io>; }
$io->close();
# send out graph image
print STDOUT $cgi->header(
-type => 'image/png',
-content_length => length($data),
-expires => '+5m'
) . $data;
# cleanup
unlink($tmpfile)
}
elsif (defined(my $explore = $cgi->param("explore"))) {
#
# output HTML page: EXPLORE A GRAPH
#
# generate HTML page diversion
my $html = new String::Divert;
$html->overload(1);
# generate HTML page skeleton
$html .=
"<html>\n" .
" <head>\n" .
" " . $html->folder("head") .
" </head>\n" .
" <body>\n" .
" " . $html->folder("body") .
" </body>\n" .
"</html>\n";
# generate HTML header
$html >> "head";
$html .= "<title>OSSP flow2rrd: Real-Time Network Statistics</title>\n";
$html .= "<link rel=\"stylesheet\" type=\"text/css\" href=\"".$cgi->url(-relative => 1)."?css=1\">\n";
$html << 1;
# generate HTML body page skeleton
$html >> "body";
$html .= "<table class=\"flow2rrd\" border=0 cellpadding=0 cellspacing=0>\n";
$html .= " <tr>\n";
$html .= " <td class=\"header\">\n";
$html .= " " . $html->folder("header");
$html .= " </td>\n";
$html .= " <tr>\n";
$html .= " </tr>\n";
$html .= " <td class=\"canvas\">\n";
$html .= " " . $html->folder("canvas");
$html .= " </td>\n";
$html .= " <tr>\n";
$html .= " </tr>\n";
$html .= " <td class=\"footer\">\n";
$html .= " " . $html->folder("footer");
$html .= " </td>\n";
$html .= " </tr>\n";
$html .= "</table>\n";
$html << 1;
# generate page header & footer
$html >> "header";
$html .= "<a href=\"".$cgi->url(-relative => 1)."\">Real-Time Network Statistics</a>";
$html << 1;
$html >> "footer";
$html .= "<a href=\"$my->{-proghome}\">$my->{-progname}</a> $my->{-progvers}";
$html << 1;
# determine input parameters (and their defaults)
my $width = ($cgi->param("width") || "800");
my $height = ($cgi->param("height") || "200");
my $start = ($cgi->param("start") || "-48h");
my $end = ($cgi->param("end") || "now");
my $ulimit = ($cgi->param("ulimit") || "0");
my $llimit = ($cgi->param("llimit") || "0");
# generate page canvas skeleton
$html >> "canvas";
$html .= $cgi->start_form(
-method => "POST",
-action => $cgi->url(-relative => 1) . "?explore=$explore",
-enctype => "application/x-www-form-urlencoded"
);
$html .= $cgi->hidden(-name => "explore", -default => $cgi->url(-relative => 1) . "?explore=$explore")."\n";
$html .= "<table class=\"explore\" border=0 cellspacing=0 cellpadding=0>\n";
$html .= " <tr>\n";
$html .= " <td class=\"view\">\n";
$html .= " " . $html->folder("view");
$html .= " </td>\n";
$html .= " </tr>\n";
$html .= " <tr>\n";
$html .= " <td class=\"toolbar\">\n";
$html .= " " . $html->folder("toolbar");
$html .= " </td>\n";
$html .= " </tr>\n";
$html .= "</table>\n";
$html .= $cgi->end_form();
$html << 1;
# generate page view part
my $img = $cgi->url(-relative => 1) . "?graph=$explore\@$width:$height:$start:$end:$ulimit:$llimit";
$html >> "view";
$html .= "<img src=\"$img\">\n";
$html << 1;
# generate page toolbar part
$html >> "toolbar";
$html .= "<table>\n";
$html .= "<tr><td>Graph Size:</td><td>" . $cgi->textfield(
-name => 'width',
-default => $width,
-size => 15,
-maxlength => 4,
-class => 'textfield',
) . "</td><td>x</td><td>" . $cgi->textfield(
-name => 'height',
-default => $height,
-size => 15,
-maxlength => 4,
-class => 'textfield',
) . "</td><td>(pixels)</td><td>Examples: '400 x 100', '800 x 200', ...</td></tr>";
$html .= "<tr><td>Data X-Range:</td><td>" . $cgi->textfield(
-name => 'start',
-default => $start,
-size => 15,
-maxlength => 20,
-class => 'textfield',
) . "</td><td>-</td><td>" . $cgi->textfield(
-name => 'end',
-default => $end,
-size => 15,
-maxlength => 20,
-class => 'textfield',
) . "</td><td>(time)</td><td>Examples: '-2d - now', '24-Dec-2004 - +48h', ...</td></tr>";
$html .= "<tr><td>Data Y-Range:</td><td>" . $cgi->textfield(
-name => 'ulimit',
-default => $ulimit,
-size => 15,
-maxlength => 10,
-class => 'textfield',
) . "</td><td>-</td><td>" . $cgi->textfield(
-name => 'llimit',
-default => $llimit,
-size => 15,
-maxlength => 10,
-class => 'textfield',
) . "</td><td>(Bit/s)</td><td>Examples: '2K - -1K', '4M - 2M', ...</td></tr>";
$html .= " <tr>\n";
$html .= " <td colspan=4>". $cgi->submit(-name => "Update Graph", -class => "submit") . "</td>\n";
$html .= " </tr>\n";
$html .= "</table>\n";
$html << 1;
# send out page
$html->undivert(0);
print STDOUT $cgi->header(
-type => 'text/html',
-content_length => length($html),
-expires => '+5m'
) . $html;
# cleanup
undef $html;
}
else {
#
# output HTML page: TOP-LEVEL SUMMARY
#
# generate HTML page diversion
my $html = new String::Divert;
$html->overload(1);
# generate HTML page skeleton
$html .=
"<html>\n" .
" <head>\n" .
" " . $html->folder("head") .
" </head>\n" .
" <body>\n" .
" " . $html->folder("body") .
" </body>\n" .
"</html>\n";
# generate HTML header
$html >> "head";
$html .= "<title>OSSP flow2rrd: Real-Time Network Statistics</title>\n";
$html .= "<link rel=\"stylesheet\" type=\"text/css\" href=\"".$cgi->url(-relative => 1)."?css=1\">\n";
$html << 1;
# generate HTML body page skeleton
$html >> "body";
$html .= "<table class=\"flow2rrd\" border=0 cellpadding=0 cellspacing=0>\n";
$html .= " <tr>\n";
$html .= " <td class=\"header\">\n";
$html .= " " . $html->folder("header");
$html .= " </td>\n";
$html .= " <tr>\n";
$html .= " </tr>\n";
$html .= " <td class=\"canvas\">\n";
$html .= " " . $html->folder("canvas");
$html .= " </td>\n";
$html .= " <tr>\n";
$html .= " </tr>\n";
$html .= " <td class=\"footer\">\n";
$html .= " " . $html->folder("footer");
$html .= " </td>\n";
$html .= " </tr>\n";
$html .= "</table>\n";
$html << 1;
# generate page header & footer
$html >> "header";
$html .= "<a href=\"".$cgi->url(-relative => 1)."\">Real-Time Network Statistics</a>";
$html << 1;
$html >> "footer";
$html .= "<a href=\"$my->{-proghome}\">$my->{-progname}</a> $my->{-progvers}";
$html << 1;
# generate page canvas structure
$html >> "canvas";
$html .= "<table border=0 cellpadding=0 cellspacing=0>\n";
$html .= " <tr>\n";
for (my $i = 0; $i < @{$cfg->{'Host'}}; $i++) {
$html .= " <td>\n";
$html .= " " . $html->folder("col$i");
$html .= " </td>\n";
}
$html .= " <tr>\n";
$html .= "</table>\n";
$html << 1;
# generate page canvas cells
for (my $i = 0; $i < @{$cfg->{'Host'}}; $i++) {
my $host = $cfg->{'Host'}->[$i];
$html >> "col$i";
$html .= "<table border=0 cellpadding=0 cellspacing=0>\n";
$html .= " <tr>\n";
$html .= " <td>\n";
my $url = $cgi->url(-relative => 1) . "?explore=$host->{-name}";
my $img = $cgi->url(-relative => 1) . "?graph=$host->{-name}\@400:100:-48h:now:0:0";
$html .= " <a href=\"$url\"><img src=\"$img\" border=0></a>\n";
$html .= " </td>\n";
$html .= " </tr>\n";
foreach my $target (@{$host->{-target}->{-order}}) {
$html .= " <tr>\n";
$html .= " <td>\n";
my $url = $cgi->url(-relative => 1) . "?explore=$host->{-name}:$target";
my $img = $cgi->url(-relative => 1) . "?graph=$host->{-name}:$target\@400:100:-48h:now:0:0";
$html .= " <a href=\"$url\"><img src=\"$img\" border=0></a>\n";
$html .= " </td>\n";
$html .= " </tr>\n";
}
$html .= "</table>\n";
$html << 1;
}
# send out page
$html->undivert(0);
print STDOUT $cgi->header(
-type => 'text/html',
-content_length => length($html),
-expires => '+5m'
) . $html;
# cleanup
undef $html;
}
}
# die gracefully
exit(0);
