#!/usr/opkg/bin/perl
##
##  flow2rrd -- store NetFlow data in Round-Robin Database (RRD)
##  Copyright (c) 2004 Ralf S. Engelschall <rse@engelschall.com> 
##

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 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 => '0.1.0',
    -progdate => '20-Dec-2004',
};

#   run-time options
my $opt = {
    -help     => 0,
    -version  => 0,
    -verbose  => 0,
    -config   => 'flow2rrd.cfg',
    -store    => 0,
    -graph    => 0,
    -cgi      => 0,
};

#   parse command line options
Getopt::Long::Configure("bundling");
my %getopt_spec = (
    'h|help'     => \$opt->{-help},
    'V|version'  => \$opt->{-version},
    'v|verbose'  => \$opt->{-verbose},
    'c|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,--verbose           enable verbose run-time mode\n" .
          "  -V,--version           print program version\n" .
          "  -c,--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} ($my->{-progdate})\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;

#   extract configuration elements
my $cfg = {
    'Database' => undef,
    'Host'     => [],
    'Protocol' => {},
    'Service'  => {},
    'Colors'   => {},
};
foreach my $dir (@{$tree}) {
    if ($dir->[0] eq 'Database') {
        die "Database already defined" if (defined($cfg->{'Database'}));
        $cfg->{'Database'} = $dir->[1];
    }
    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
sub make_rrd_ds_name {
    my ($host, $target, $service) = @_;
    $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); 
    my $ds_name = sprintf("%s_%s_%s", $host, $target, $service);
    return $ds_name;
}

##
##  ==== OPERATION MODE 1: STORE DATA ====
##

if ($opt->{-store}) {
    my $step = 5*60; # 5 min

    #   initialize data
    my $ctx = &data_init($cfg);

    #   scan flow-tools stream on STDIN for NetFlow records
    Cflow::verbose(1);
    Cflow::find(sub { &foreach_record($cfg, $ctx) }, "-");
    sub foreach_record {
        my ($cfg, $ctx) = @_;

        #   determine time slot
        my $t = $Cflow::endtime;
        if (not defined($ctx->{-endtime})) {
            #   initial setup, so initialize time slot tracking
            $ctx->{-starttime} = int($t / $step) * $step;
            $ctx->{-endtime}   = $ctx->{-starttime} + $step;

            #   load data
            &rrd_load($cfg, $ctx);
        }

        #   at end of time slot, store accumulated data
        if ($t >= $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);
    }
    &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'});

        #   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);
        }
        &mkrra($step,     5*60,     7*24*60*60); #  5 min  res. for 1 week
        &mkrra($step,    10*60,    14*24*60*60); # 10 min  res. for 2 weeks
        &mkrra($step,    30*60,    30*24*60*60); # 30 min  res. for 1 month
        &mkrra($step,    60*60,  3*30*24*60*60); #  1 hour res. for 3 months
        &mkrra($step,  3*60*60,  6*30*24*60*60); #  3 hour res. for 6 months
        &mkrra($step,  6*60*60,   365*24*60*60); #  6 hour res. for 1 year
        &mkrra($step, 24*60*60, 4*365*24*60*60); #  1 days res. for 4 year

        #   create RRD database
        RRDs::create($cfg->{'Database'}, '--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'},
            '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) = @_;

        #my $st = POSIX::ctime($Cflow::startime); $st =~ s/\r?\n$//s;
        #my $et = POSIX::ctime($Cflow::endtime);  $et =~ s/\r?\n$//s;
        #printf(STDERR "%s %15.15s.%-5hu %15.15s.%-5hu %2hu %3u %u\n",
        #       $et,
        #       $Cflow::srcip, $Cflow::srcport,
        #       $Cflow::dstip, $Cflow::dstport,
        #       $Cflow::protocol, $Cflow::bytes);

        #   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 (grep { $_ !~ m/^-/ } keys(%{$host->{-target}})) {
                my $matched = 0;
                my $inbound; $inbound = undef;
                my $np = $ctx->{-network}->{$host->{-name}.":".$target};
                if ($np->match_string($Cflow::srcip)) { $inbound = 0; }
                if ($np->match_string($Cflow::dstip)) { $inbound = 1; }
                if (defined($inbound)) {
                    foreach my $service (@{$host->{-target}->{$target}->{-service}}) {
                        my $services = $cfg->{'Service'}->{$service};
                        foreach my $s (@{$services}) {
                            my $proto = $cfg->{'Protocol'}->{$s->{-proto}};
                            my $port  = $s->{-port};
                            if ($Cflow::protocol == $proto) {
                                if (   (    $inbound and $Cflow::dstport == $port)
                                    or (not $inbound and $Cflow::srcport == $port)) {
                                    $matched = 1;
                                }
                            }
                            if ($matched) {
                                #   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'},
            '--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");
        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; }
            }
            else {
                $t = 0;
            }
            return $t;
        }
        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);
        }
        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;
        }
        $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;
            #   FIXME: UNKNOWN data?
            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'}, $ds_name));
                    push(@def, sprintf("DEF:%s_i=%s:%s_i:LAST", $ds_name, $cfg->{'Database'}, $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 - 0x404040";
                push(@draw_o, sprintf("%s:data%d_o#%06x:%s out", ($i == 0 ? "AREA" : "STACK"), $i, $color_o, $target));
                push(@draw_i, sprintf("%s:data%d_i#%06x:%s in",  ($i == 0 ? "AREA" : "STACK"), $i, $color_i, $target));
                $i++;
            }
            my @draw = (@draw_o, "COMMENT:\n", @draw_i, "HRULE:0#000000");
            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#000000');
            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) = RRDs::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;
            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'}, $ds_name));
                push(@def,    sprintf("DEF:%s_i=%s:%s_i:LAST", $ds_name, $cfg->{'Database'}, $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 - 0x404040";
                push(@draw_o, sprintf("%s:data%d_o#%06x:%s out", ($i == 0 ? "AREA" : "STACK"), $i, $color_o, $service));
                push(@draw_i, sprintf("%s:data%d_i#%06x:%s in",  ($i == 0 ? "AREA" : "STACK"), $i, $color_i, $service));
                $i++;
            }
            my @draw = (@draw_o, "COMMENT:\n", @draw_i, "HRULE:0#000000");
            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#000000');
            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) = RRDs::graph(@args);
            my $err = RRDs::error();
            die "failed to generate graph from RRD file: $err" if (defined($err));
        }
    }
}

##
##  ==== OPERATION MODE 3: GENERATE WEB USER INTERFACE ====
##

if ($opt->{-cgi}) {
    my $cgi = new 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)
        #

        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 page
        $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
        #die "$0 --graph $graph";
        my $rc = system("$0 --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);

        $html .=
            "<html>\n" .
            "  <head>\n" .
            "    " . $html->folder("head") .
            "  </head>\n" .
            "  <body>\n" .
            "    " . $html->folder("body") .
            "  </body>\n" .
            "</html>\n";

        $html >> "head";
        $html .= "<link rel=\"stylesheet\" type=\"text/css\" href=\"".$cgi->url(-relative => 1)."?css=1\">\n";
        $html << 1;

        $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;

        $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} ($my->{-progdate})";
        $html << 1;

        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");

        $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;

        my $img = $cgi->url(-relative => 1) . "?graph=$explore\@$width:$height:$start:$end:$ulimit:$llimit";
        $html >> "view";
        $html .= "<img src=\"$img\">\n";
        $html << 1;

        $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);

        $html .=
            "<html>\n" .
            "  <head>\n" .
            "    " . $html->folder("head") .
            "  </head>\n" .
            "  <body>\n" .
            "    " . $html->folder("body") .
            "  </body>\n" .
            "</html>\n";

        $html >> "head";
        $html .= "<link rel=\"stylesheet\" type=\"text/css\" href=\"".$cgi->url(-relative => 1)."?css=1\">\n";
        $html << 1;

        $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;

        $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} ($my->{-progdate})";
        $html << 1;

        $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;

        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;
    }

    # width
    # height
    # start-time
    # end-time
    # upper-limit
    # lower-limit
}

exit(0);