#!/usr/bin/perl
#
# Obtains and collects accounting information from cisco or PC routers.
# Should be run every 5 minutes via cron.
#
# Usage:
# AcctFetch [-c ciscorouter1,[...,ciscorouterN]] \
#           [-p pcrouter1,[...,pcrouterM]]
#

use strict;
use vars qw( $opt_c $opt_p $prefix $cisco_fetch_command $pc_fetch_command );
use DB_File;
use Fcntl ':flock';
use IO::Seekable 'SEEK_SET';
use Socket;
require 'getopts.pl';
require '/usr/local/etc/tas/tas.conf';

# Providing default values for config parameters:
$prefix = '/var/account' unless defined $prefix;
$cisco_fetch_command = '/usr/bin/rsh $router show ip accounting checkpoint' unless defined $cisco_fetch_command;
$pc_fetch_command = '/usr/bin/ssh $router /usr/local/bin/TrafShowAll' unless defined $pc_fetch_command;

my $fileprefix = "$prefix/ip";
my $out_from_file = "$fileprefix.today.from.db";
my $out_to_file = "$fileprefix.today.to.db";
my $shift_prefix = "$fileprefix.yesterday";
my $shift_from_file = "$shift_prefix.from.db";
my $shift_to_file = "$shift_prefix.to.db";
my $stampfile = "$fileprefix.stamp";

my $curtime;
my $lastrun;
my $sec;
my $min;
my $hour;
my @oldshifted;
my ( $src, $dst );
my $router;
my @router_data;
my $pckts;
my $bytes;
my %from_acctdb;
my %to_acctdb;
my ( $from_bin, $to_bin );
my @cisco;
my @pc;

Getopts('c:p:');

if( $opt_c ){	# getting list of Cisco routers
	@cisco = split ',', $opt_c;
}
if( $opt_p ){	# getting list of PC routers
	@pc = split ',', $opt_p;
}

# read timestamp of previous run and write a new one:
$curtime = time();

if( open( STAMP, "+<$stampfile" ) ){
        flock( STAMP, LOCK_EX ) || die "Can\'t lock filehandle: $!";
        $lastrun = <STAMP>;
}else{
        open( STAMP, ">$stampfile" ) || die "Can\'t open file: $!";
        flock( STAMP, LOCK_EX ) || die "Can\'t lock filehandle: $!";
}
seek STAMP, 0, SEEK_SET;
print STAMP $curtime;   
$lastrun = 0 unless $lastrun;


# shifting database if needed:
( $sec, $min, $hour ) = localtime( $curtime );
if( $curtime - ( $hour * 3600 + $min * 60 + $sec ) > $lastrun ){
	# previous run was before 00:00, so we should shift database

	# if found older shifted files, rotate them:
	@oldshifted = <$shift_prefix.[1-9]*>;
	unshift @oldshifted, <$shift_prefix.[^1-9]*>;
	while ( @oldshifted ){
		$src = $dst = pop @oldshifted;
		$dst =~ s/\.((\d*)\.)?(from|to)\.db/".".($2+1).".$3.db"/e;
		rename $src, $dst;
	}
	# shift the database:
	rename $out_from_file, $shift_from_file;
	rename $out_to_file, $shift_to_file;
}

foreach $router ( @cisco ){

	unless( open( ROUTER, eval( "\"$cisco_fetch_command |\"" ) ) ){
		print STDERR "Can't fetch from $router: $!\n";
		next;
	}

	@router_data = <ROUTER>;

	tie( %from_acctdb, 'DB_File', "$out_from_file", O_CREAT|O_RDWR, 0644, $DB_BTREE ) || die "Can\'t tie $out_from_file database: $!";
	tie( %to_acctdb, 'DB_File', "$out_to_file", O_CREAT|O_RDWR, 0644, $DB_BTREE ) || die "Can\'t tie $out_to_file database: $!";
	foreach( @router_data ){
		if( /^\s*(\d+\.\d+\.\d+\.\d+)\s+(\d+\.\d+\.\d+\.\d+)\s+(\d+)\s+(\d+)\s*$/ ){
			$from_bin = inet_aton( $1 );
			$to_bin = inet_aton( $2 );
			( $pckts, $bytes ) = split ' ', $from_acctdb{"a$from_bin a$to_bin $router ip *"};
			$pckts += $3;
			$bytes += $4;
			$from_acctdb{"a$from_bin a$to_bin $router ip *"} = "$pckts $bytes";
			$to_acctdb{"a$to_bin a$from_bin $router ip *"} = "$pckts $bytes";
		}elsif( /^Accounting threshold exceeded/ ){
			print STDERR;
		}
	}
	untie %from_acctdb;
	untie %to_acctdb;
	close ROUTER;
}

foreach $router ( @pc ){

	unless( open( ROUTER, eval( "\"$pc_fetch_command |\"" ) ) ){
		print STDERR "Can't fetch from $router: $!\n";
		next;
	}

	@router_data = <ROUTER>;

	tie( %from_acctdb, 'DB_File', "$out_from_file", O_CREAT|O_RDWR, 0644, $DB_BTREE ) || die "Can\'t tie $out_from_file database: $!";
	tie( %to_acctdb, 'DB_File', "$out_to_file", O_CREAT|O_RDWR, 0644, $DB_BTREE ) || die "Can\'t tie $out_to_file database: $!";
	foreach( @router_data ){
		if( split( ' ' )
		&& $_[ 0 ] =~ /^\d+\.\d+\.\d+\.\d+$/o
		&& $_[ 1 ] =~ /^\d+\.\d+\.\d+\.\d+$/o
		&& $_[ 2 ] =~ /^\d+$/o
		&& $_[ 3 ] =~ /^\d+$/o ){
			$_[ 4 ] = $router unless $_[ 4 ];
			$_[ 5 ] = 'ip' unless $_[ 5 ];
			$_[ 6 ] = '*' unless $_[ 6 ];
			$from_bin = inet_aton( $_[ 0 ] );
			$to_bin = inet_aton( $_[ 1 ] );
			( $pckts, $bytes ) = split ' ', $from_acctdb{"a$from_bin a$to_bin $_[ 4 ] $_[ 5 ] $_[ 6 ]"};
			$pckts += $_[ 2 ];
			$bytes += $_[ 3 ];
			$from_acctdb{"a$from_bin a$to_bin $_[ 4 ] $_[ 5 ] $_[ 6 ]"} = "$pckts $bytes";
			$to_acctdb{"a$to_bin a$from_bin $_[ 4 ] $_[ 5 ] $_[ 6 ]"} = "$pckts $bytes";
		}else{
			print STDERR "Bad record received from $router: \"$_\"!\n";
		}
	}
	untie %from_acctdb;
	untie %to_acctdb;
	close ROUTER;
}

close STAMP;	# unlock
