#!/usr/bin/perl
#
# Obtains and collects accounting information from cisco routers.
# Should be run every 5 minutes via cron.

use strict;
use Socket;
use Fcntl ':flock';
use IO::Seekable 'SEEK_SET';
use DB_File;

use vars qw( $prefix );

require '/usr/local/etc/tas/tas.conf';

# Providing default values for config parameters:
$prefix = '/var/account' unless defined $prefix;

sub compile_host
{
	my $host = shift;

	if( $host =~ /^\d+\.\d+\.\d+\.\d+$/ ){
		return "a" . inet_aton( $host );
	}else{
		my @name = split /\./, $host;
		my $reversed = $name[ $#name ];
		my $i;

		for( $i = $#name - 1; $i >= 0; $i-- ){
			$reversed .= ".";
			$reversed .= $name[ $i ];
		}
		return "d$reversed";
	}
}


# Resolve short server name to FQDN (short name is not acceptable for us)
# Argument - domain name
# Returns ip address or the argument if unresolved
#
{
my %resolve_cache;	# static object
sub resolve
{
	my $name = shift;
	my $fqdn = '';
	my $result;

	if( exists( $resolve_cache{$name} ) ){
		$fqdn = $resolve_cache{$name};
	}else{
		( $fqdn ) = gethostbyname( $name );
		$resolve_cache{$name} = $fqdn;	# we cache even unresolved names
	}
	$result = ( $fqdn ? $fqdn : $name );		# gethostbyaddr also returns '' on error
	return $result;
}
}


my $fileprefix = "$prefix/sendmail";
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 $size;
my $relay;
my %msg;
my @fields;
my $id;
my $mailer;
my $key;
my @oldshifted;
my( $src, $dst );
my( $from_compiled, $to_compiled );	# compiled name/address of source and destination
my $agent_host;
my $pckts;
my $bytes;
my %from_acctdb;
my %to_acctdb;

# we must _not_ make STDIN unbuffered as in this case we couldn't
# catch consequent "from" and "to" records for the same message, because
# this script will exit each time when nothing is presented on STDIN
# ( eof() will return non-zero ).

while( !eof( STDIN ) ){
	# we _should_ check for eof instead of making infinitive loop because
	# else we'll become zombie after syslog closes pipe or exits

	# read timestamp of previous run and write a new one:
	$curtime = time();
	if( open( STAMP, "+<$stampfile" ) ){	# stamp file already exists
	        flock( STAMP, LOCK_EX ) || die "Can\'t lock filehandle: $!";
	        $lastrun = <STAMP>;
	}else{	# stamp file does not exist
	        open( STAMP, ">$stampfile" ) || die "Can\'t open $stampfile: $!";
	        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;
	}

 	unless ( $_ = <> ){
		close STAMP;
		sleep( 1 );
		next;
	}

	@fields = split ' ';
	$id = "$fields[ 5 ]$fields[ 3 ]";	# "id_code:server"
	if( /\sfrom=.+\ssize=(\d+).+\srelay=([^\n\, ]+)/ ){
		$size = $1;
		$relay = $2;
		if( ! $relay || $relay =~ /localhost$/ ){
			$relay = resolve( $fields[ 3 ] ) unless $fields[ 3 ] =~ /[^\.]\.[^\.]/;	# not fqdn
		}else{
			if( $relay =~ /\[(\d+\.\d+\.\d+\.\d+)\]/ ){
				$relay = $1;
			}else{
				$relay =~ s/\.$//;
				$relay =~ s/^.+\@//;
			}
		}
		$msg{$id}->[ 0 ] = $relay;	# we identify messages by message ids, because there are more than one log records about the same message...
		$msg{$id}->[ 1 ] = $size;
	}elsif( /\sto=.+\smailer=([^\n\,]+).+\srelay=([^\n\, ]+).+\sstat=Sent/ && exists $msg{$id} ){
		$mailer = $1;
		$relay = $2;
		if( ! $relay || $mailer eq 'cyrus' || $mailer =~ /uucp-dom$/ ){
			# mail receiver is local, so we use our mail server name as a destination relay:
			$relay = resolve( $fields[ 3 ] ) unless $fields[ 3 ] =~ /[^\.]\.[^\.]/;	# not fqdn
		}else{
			# canonifying relay record (we need only host name or address):
			if( $relay =~ /\[(\d+\.\d+\.\d+\.\d+)\]/ ){
				$relay = $1;
			}else{
				$relay =~ s/\.$//;
				$relay =~ s/^.+\@//;
			}
		}
		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: $!";

		$from_compiled = compile_host( $msg{$id}->[ 0 ] );
		$to_compiled = compile_host( $relay );
		$agent_host = $fields[ 3 ];
		( $pckts, $bytes ) = split ' ', $from_acctdb{"$from_compiled $to_compiled $agent_host smtp *"};
		$pckts ++;
		$bytes += $msg{$id}->[ 1 ];
		$from_acctdb{"$from_compiled $to_compiled $agent_host smtp *"} = "$pckts $bytes";
		$to_acctdb{"$to_compiled $from_compiled $agent_host smtp *"} = "$pckts $bytes";

		untie %from_acctdb;
		untie %to_acctdb;
	}
	close STAMP;
}


