#!/usr/bin/perl -w
#
# Exracts accounting data from accounting log files
#
# see usage() for help
#

use strict;
no strict 'refs';	# needed for initializing $opt_* variables
use Socket;
use POSIX qw( ceil floor );
use DB_File;
use vars qw( $opt_d $opt_v $opt_f $opt_h @local_nets @compiled_local_nets %lists %compiled_lists %tables $sort_column $table_rows $traffic_type );


###########################################################################
# Auxiliary procedures
###########################################################################

# Resolve ip address
# Argument - ip address (in binary form)
# Returns reversed domain name or '' if not resolved
#
{
my %resolve_cache;	# static object
sub resolve
{
	my $address = $_[ 0 ];
	my $name = '';

	return '' unless $address;
	return '' unless cmp_addr_local_nets( $address );

	if( exists( $resolve_cache{$address} ) ){
		$name = $resolve_cache{$address};
	}else{
		$name = gethostbyaddr( $address, AF_INET );
							# gethostbyaddr also returns '' on error
		$resolve_cache{$address} = $name;	# we cache even unresolved addresses
	}
	return $name;
}
}

# Round up the floating point value to an integral one
# Arguments:
# - value to round
# - rounding mode (up|down|nearest)
#
sub round_float
{
	my $value = shift;
	my $mode = lc( shift );

	if( $mode eq 'up' ){
                return ceil( $value );
        }elsif( $mode eq 'down' ){
                return floor( $value );
        }else{  # 'nearest'
                return sprintf( "%.0f", $value );
        }
}


# Sort between two table rows according to given options.
# Uses global variables $a, $b, $traffic_type, %tables, %groups.
#
sub table_sort
{
	my $num = abs( $sort_column );

	if( $sort_column < 0 ){
		return $b cmp $a if( $num == 1 );
		return $table_rows->{$b}->[ $num - 2 ] <=> $table_rows->{$a}->[ $num - 2 ];
	}else{
		return $a cmp $b if( $num == 1 );
		return $table_rows->{$a}->[ $num - 2 ] <=> $table_rows->{$b}->[ $num - 2 ];
	}
}


###########################################################################
# Compilation procedures, used to transform data structures read from
# the configuration file into a form for faster processing
###########################################################################

# Compile domain into the form used in database
# (for ex., "xxx.yyy.com" -> "com.yyy.xxx").
# Argument - domain name
# Returns reversed domain name
#
sub compile_domain
{
	return '' unless $_[ 0 ];

	my @name = split /\./, $_[ 0 ];
	my $reversed = $name[ $#name ];
	my $i;

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


# Translates "address/mask_len" into binary form
# Arguments:
# - subnet address string
# - mask len
# Returns pair (net, mask) in binary form
#
sub compile_net
{
	return ( inet_aton( $_[ 0 ] ), pack( "N", 0xffffffff + 1 - 2 ** ( 32 - $_[ 1 ] ) ) );
		# We don't use ~( 0xffffffff >> $_[ 1 ] ) here because ">>" operator
		# can work with 4-byte values only, and returns 0xffffffff instead
		# of 0 when a number is shifted right by 32 bits.
		# We also cannot use 0x100000000 instead of (0xffffffff + 1)
		# because perl understands only 4-bit integers, however operates
		# them as floating point numbers.
}


# Comopile a single host group for faster processing
# Argument - string representing the host group
# Returns compiled structure. The only required field of the group structure
# is 'type'; the others are type-specific (see code for details).
#
sub compile_group
{
	my $group = shift;
	my $addr;
	my $mask;

	if( $group eq 'total' || $group eq 'each' ){
		return {	'type' => $group };
	}elsif( $group =~ /^\d+\.\d+\.\d+\.\d+$/o ){
		( $addr, $mask ) = compile_net( $group, 32 );
		return {	'type' => 'net',
				'addr' => $addr,
				'mask' => $mask,
				'symbolic_net' => $group,
				'split' => '*'	# to be resolved into name when
						# the resolve parameter was
						# set for the table
			};
	}elsif( $group =~ /^(\*?)(\d+\.\d+\.\d+\.\d+)\/(\d+)$/o ){
		( $addr, $mask ) = compile_net( $2, $3 );
		return {	'type' => 'net',
				'addr' => $addr & $mask,
					# for the case if user specified not the
					# first address in subnet as subnet address
				'mask' => $mask,
				'symbolic_net' => "$2/$3",
				'split' => ( $1 ? $1 : '' )
			};
	}elsif( $group =~ /^(\*?)([A-Za-z_ ]+)$/o && exists $lists{$2} ){
		return {	'type' => 'list',
				'listname' => $2,
				'split' => ( $1 ? $1 : '' )
			};
	}elsif( $group =~ /^([\?\*]?)([^\?\*]+)$/o ){
		return {	'type' => 'domain',
				'name' => compile_domain( $2 ),
				'symbolic_name' => $2,
				'split' => ( $1 ? $1 : '' )
			};
	}else{
		return undef;
	}
}


# Compile local_nets list for faster processing
#
sub compile_local_nets
{
	foreach ( @local_nets ) {
		if( /^(\d+\.\d+\.\d+\.\d+)\/(\d+)$/o ){
			push @compiled_local_nets, [ compile_net( $1, $2 ) ];
		}else{
			die "Bad value in \@local_nets list: $_\n";
		}
	}
}


# Compile group lists for faster processing
#
sub compile_lists
{
	my $list;		# a configured list of groups
	my $group;

	foreach $list ( keys %lists ){

		if( $list eq 'total' || $list eq 'each' ){
			die "Bad list name: '$list' is a reserved word\n";
		}

		foreach ( @{$lists{$list}} ){

			$group = compile_group( $_ );

			if( defined $group ){
				push @{$compiled_lists{$list}}, $group;
			}else{
				die "Bad value in list '$list': $_\n";
			}
		}
	}
}


# Compile an operand of a category expression
# Arguments:
# - operand's sign
# - operand's body
# Returns reference to list of hashes { 'sign', 'group', 'header' } where
# sign is "+" or "-", group is a host group structure as produced by
# comiple_group() and header is the table row header to which a host's traffic
# should be added if the host belongs to this group.
#
sub compile_catexp_operand
{
	my $sign = shift;
	my $group = shift;
	my $header = shift;	# table row header (if already known) or undef
	my $operands = [];
	my $operand_list;

	if( $group->{'type'} eq 'list' ){
		foreach( @{$compiled_lists{$group->{'listname'}}} ){
			$operand_list = compile_catexp_operand(
				$sign,
				$_,	# a list element is an already compiled group
				( $header
					? $header		# already known
					: ( $group->{'split'}
						? undef		# will be known at deeper level
						: $group->{'listname'} ) )
								# this list's name,
								# regardless of the
								# deeper hierarchy's
								# splitting options
				);
			push @$operands, @$operand_list;
		}
	}else{
		push @$operands, {
			'sign' => $sign,
			'group' => $group,
			'header' => $header,	# if the header is not known
						# at this level yet, then it
						# will be determined according
						# to the group's split option.
			'skip' => 0
		};
	}
	return $operands;
}

# Compile a category expression
# Argument - category expression
# Returns reference to list of hashes { 'sign', 'group', 'header' } where
# sign is "+" or "-", group is a host group structure as produced by
# comiple_group() and header is the table row header to which a host's traffic
# should be added if the host belongs to this group.
#
sub compile_catexp
{
	my $catexp = shift;
	my @list;
	my $operands = [];
	my $operand_list;
	my $group;
	my ( $i, $j );

	$catexp =~ s/([+-])/:$1/g;	# we need a field separator
					# other than an expression sign
	@list = split( ':', $catexp );
	foreach ( @list ){
		if( /^([+-]?)(.+)$/ ){
			$group  = compile_group( $2 );
			unless( defined $group ){
				die "Bad group value \"$2\" in category expression \"$catexp\"!";
			}
			$operand_list = compile_catexp_operand(
				( $1 eq '-'
					? '-'
					: '+' ),	# the leftmost operand may not contain '+'
				$group,
				( ( $group->{'type'} eq 'list'
				&& ! $group->{'split'} )
					? $group->{'listname'}	# this list's name
								# should be used as
								# a table row
								# regardless of the
								# deeper hierarchy's
								# splitting options
					: undef )
				);
			push @$operands, @$operand_list;
		}else{
			die "Bad operand in category expression \"$catexp\"!"; 
		}
	}

	# marking redundant operands that are subsets of any following ones
	# to prevent repeated selection from database:
	for( $i = 0; $i < @$operands; $i++ ){
		for( $j = $i + 1; $j < @$operands; $j++ ){
			if( cmp_group_group( $operands->[ $j ]->{'group'}, $operands->[ $i ]->{'group'} ) ){
				$operands->[ $i ]->{'skip'} = 1;
				last;
			}
		}
	}

	# marking redundant operands that are subsets of any preceeding ones
	# within each same-sign succession to prevent repeated selection from
	# database:
	for( $i = $#$operands; $i >= 0; $i-- ){
		for( $j = $i - 1; $j >= 0 && $operands->[ $j ]->{'sign'} eq $operands->[ $i ]->{'sign'}; $j-- ){
			if( cmp_group_group( $operands->[ $j ]->{'group'}, $operands->[ $i ]->{'group'} ) ){
				$operands->[ $i ]->{'skip'} = 1;
				last;
			}
		}
	}

	return $operands;
}


# Compile table descriptions for faster processing.
# We leave %tables hash the same, only compile category
# expressions, tag lists and resolve flags.
#
sub compile_tables
{
	my $table;
	my $column;

	unless( exists $tables{$traffic_type} ){
		die "There's no tables definition for traffic type \"$traffic_type\"!";
	}

	foreach $table ( @{$tables{$traffic_type}} ){

		# compile category expression:
		$table->[ 1 ] = compile_catexp( $table->[ 1 ] );

		unless( $table->[ 2 ] =~ /^[+-]?\d+$/
		&& $table->[ 2 ] != 0
		&& $table->[ 2 ] <= @{$table->[ 4 ]} ){
			die( "Bad sort parameter \"$table->[ 2 ]\" in table \"$table->[ 0 ]\", traffic type \"$traffic_type\"!" );
		} 
		unless( $table->[ 3 ] =~ /^true|false$/i ){
			die( "Bad resolve flag \"$table->[ 3 ]\" in table \"$table->[ 0 ]\", traffic type \"$traffic_type\"!" );
		} 
		# compile resolve flag:
		$table->[ 3 ] = ( $table->[ 3 ] =~ /^true$/i ? 1 : 0 );

		foreach $column ( @{$table->[ 4 ]} ){
			unless( $column->[ 1 ] =~ /^[A-Za-z0-9_\-\+\. ]+$/ ){
				die( "Bad category expression \"$column->[ 1 ]\" in column \"$column->[ 0 ]\", table \"$table->[ 0 ]\", traffic type \"$traffic_type\"!" );
			}
			# compile category expression:
			$column->[ 1 ] = compile_catexp( $column->[ 1 ] );

			unless( $column->[ 2 ] =~ /^from|to|both$/i ){
				die( "Bad traffic direction \"$column->[ 2 ]\" in column \"$column->[ 0 ]\", table \"$table->[ 0 ]\", traffic type \"$traffic_type\"!" );
			}
			unless( $column->[ 3 ] =~ /^[kmg]?bytes|items$/i ){
				die( "Bad measurement units \"$column->[ 3 ]\" in column \"$column->[ 0 ]\", table \"$table->[ 0 ]\", traffic type \"$traffic_type\"!" );
			}
			# compile agent host list:
			$column->[ 4 ] = $column->[ 4 ] ? [ split( ',', $column->[ 4 ] ) ] : [];
			# compile protocol list:
			$column->[ 5 ] = $column->[ 5 ] ? [ split( ',', $column->[ 5 ] ) ] : [];
			# compile status list:
			$column->[ 6 ] = $column->[ 6 ] ? [ split( ',', $column->[ 6 ] ) ] : [];
		}

		$table->[ 5 ] = 'nearest' unless defined $table->[ 5 ];
		unless( $table->[ 5 ] =~ /^up|down|nearest$/i ){
			die( "Bad rounding option \"$table->[ 5 ]\" in table \"$table->[ 0 ]\", traffic type \"$traffic_type\"!" );
		} 
	}
}


###########################################################################
# Comparison procedures. Used to decide whether a given object belongs
# to a given set.
###########################################################################

# Check whether a given host address belongs to a given subnet
# Arguments:
# - subnet address
# - subnet mask
# - host address
# (all in numeric form)
# Returns true if address belongs to subnet, false otherwise.
#
sub cmp_addr_net
{
	my ( $net, $mask, $address ) = @_;
	return ( $address & $mask ) eq $net ? 1 : 0;
		# we use "eq" instead of "==" here because operands
		# are the binary strings.
}


# Decide whether the given address belongs to local networks
# Argument - ip address
# Returns 1 or 0
#
sub cmp_addr_local_nets
{
	foreach ( @compiled_local_nets ){
		return 1 if( cmp_addr_net( $_->[ 0 ], $_->[ 1 ], $_[ 0 ] ) );
	}
	return 0;
}


# Decide whether the given tag (representing either agent host, protocol
# or status) belongs to the given tag list.
# Arguments:
# - reference to tags list
# - tag
# Returns true or false.
#
sub cmp_tag_taglist
{
	my $listref = $_[ 0 ];	# tags list
	my $tag = $_[ 1 ];	# tag to check
	my $elem;		# tags list element

	return 1 unless( @$listref );

	foreach $elem ( @$listref ){
		return 1 if ( $elem eq '*' ) || ( uc( $tag ) eq uc( $elem ) );
	}
	return 0;
}


# Decide whether the first of the given groups is inclusive to the second one.
# Arguments:
# - group structure (as produced by compile_group())
# - group structure (as produced by compile_group())
# Returns 1 if the first group is a subset of the second one (or the
# groups are equal); 0 otherwise.
#
sub cmp_group_group
{
	my ( $group1, $group2 ) = @_;

	if( $group1->{'type'} eq 'total'
	|| $group1->{'type'} eq 'each'
	|| $group1->{'type'} eq 'net'
	&& $group2->{'type'} eq 'net'
	&& cmp_addr_net( $group1->{'addr'}, $group1->{'mask'}, $group2->{'addr'} )
	|| $group1->{'type'} eq 'domain'
	&& $group2->{'type'} eq 'domain'
	&& $group2->{'name'} =~ /^$group1->{'name'}(\.[^.]+)*$/ ){
		return 1;
	}else{
		return 0;
	}
}


# Decide whether the given host belongs to the given host group.
# Returns header of the table row for which this host's data should be added.
# Arguments:
# - reference to a host group structure (as produced by compile_group())
# - reference to the host structure (as produced by process_key())
# - whether or not to resolve host address if host is specified as ip address
#   and satisfy the category expression
#
sub cmp_host_group
{
	my $group = $_[ 0 ];
	my $host = $_[ 1 ];
	my $do_resolve = $_[ 2 ];

	if( $group->{'type'} eq 'total' ){

		return 'total';

	}elsif( $group->{'type'} eq 'each' ){

		return ( $host->{'symbolic_addr'} && !$do_resolve || !$host->{'symbolic_name'} )
			? $host->{'symbolic_addr'}
			: $host->{'symbolic_name'};

	}elsif( $group->{'type'} eq 'net' && cmp_addr_net( $group->{'addr'}, $group->{'mask'}, $host->{'addr'} ) ){

		return $group->{'split'}
			? ( $host->{'symbolic_name'} && $do_resolve
				? $host->{'symbolic_name'}
				: $host->{'symbolic_addr'} )
			: $group->{'symbolic_net'};

	}elsif( $group->{'type'} eq 'domain'
	&& $host->{'symbolic_name'}
	&& $host->{'symbolic_name'} =~ /^([^.]+\.)*$group->{'symbolic_name'}$/ ){

		if( $group->{'split'} eq '?' ){
			return ( $1 ? $1 : '' ) . $group->{'symbolic_name'};
		}elsif( $group->{'split'} eq '*' ){
			return $host->{'symbolic_name'};
		}else{	# no split
			return $group->{'symbolic_name'};
		}
	}

	return undef;	# the host does not belong to this group
}


# Decide whether the given host matches the given category expression
# ( a list of +/- signed groups where each consequent sign change means
# that the following group is an exclusion from the previous groups with
# a different sign).
# If the host satisfies the expression, returns list of the table row headers
# the given host corresponds to. Otherwise returns empty list.
# Arguments:
# - reference to a compiled category expression
# - reference to the host structure (as produced by process_key())
# - whether or not to resolve host address if host is specified as ip address
#   and satisfy the category expression
# - whether to search for all group matches (1), or stop after the first match
#   (0).
#
sub cmp_host_catexp
{
	my $cat_list_ref = $_[ 0 ];
	my $host = $_[ 1 ];
	my $do_resolve = $_[ 2 ];
	my $all_matches = $_[ 3 ];
	my $i;
	my $header;		# header determined according to a metched group
	my $final_header;	# either operand's predefined header or header
				# determined according to a matched group
	my %headers = ();	# what to return (we use hash instead of array
				# to ensure all headers are unique
	my $found;		# flag: whether the determined header already
				# presents in headers list

	# starting to check from the end of operand list because
	# operands of each sign are exclusion from operands of a previous
	# (different) sign:
	for( $i = $#$cat_list_ref; $i >= 0; $i-- ){

		if( $header = cmp_host_group( $cat_list_ref->[ $i ]->{'group'}, $host, $do_resolve ) ){
			if( $cat_list_ref->[ $i ]->{'sign'} eq '+' ){
				$final_header = ( $cat_list_ref->[ $i ]->{'header'}
						? $cat_list_ref->[ $i ]->{'header'}
							# the header is already
							# predefined for this group
						: $header );
				$headers{$final_header} = undef;
				last unless $all_matches;
			}elsif( !%headers ){
				last;	# host belongs to an exclusive group,
					# but doesn't belong to any inclusive
					# group that stays after it in the
					# category expression, so it should not
					# be counted by any way, and we do not
					# check further.
			}
		}
	}
	return keys %headers;
}


###########################################################################
# Range keys procedures.
# Used to obtain start keys for address or domain ranges.
###########################################################################

# Get start keys for address or domain ranges specified by the given group.
# Arguments:
# - '+' for inclusive group, '-' for exclusive group
# - host group structure (as produced by compile_group())
# Returns the first possible key belonging to range of an inclusive group or
# all the first possible key following range of an exclusive group but not
# belonging to it.
#
sub range_keys_group
{
	my $sign = shift;
	my $group = shift;

	if( $group->{'type'} eq 'total'
	|| $group->{'type'} eq 'each' ){

		return "\0";

	}elsif( $group->{'type'} eq 'net' ){

		if( $sign eq '+' ){	# inclusive range
			return "a$group->{'addr'}";
				# the first address in a subnet is the address
				# of that subnet itself
		}else{	# exclusive range
			return "a" . pack("N", unpack("N", $group->{'addr'} | ~$group->{'mask'} ) +1 );
				# the first address beyond subnet is the last
				# address of that subnet + 1
		}

	}elsif( $group->{'type'} eq 'domain' ){

		if( $sign eq '+' ){	# inclusive range
			return "d$group->{'name'}";
				# domain name itself is always lexically first
				# in the domain it specifies.
		}else{	# exclusive range
			return "d$group->{'name'}\0";
				# any string followed by "\0" always
				# most closely follows the original
				# string in lexical order
		}
	}else{	# should not reach here
		return undef;
	}
}


# Convert category expression to a list of start keys for each of key ranges
# represented by the category expression. 
# Argument - reference to a compiled category expression (as produced by
# compile_catexp())
# Returns reference to array of start keys.
#
sub range_keys_catexp
{
	my $catexp_ref = shift;
	my @start_keys = ();

	foreach ( @$catexp_ref ){
		unless( $_->{'skip'} ){	# don't produce start keys for redundant operands
			push @start_keys, range_keys_group( $_->{'sign'}, $_->{'group'} );
		}
	}

	return [ sort @start_keys ];
}


###########################################################################
# Data processing procedures
###########################################################################

# Parse record key, obtained from the database.
# Arguments:
# - left address hash reference
# - right address hash reference
# - agent host reference
# - protocol reference
# - status reference
# Returns 1 on success, 0 on failure
sub process_key
{
	my $key = shift;
	my $left = shift;		# left address in the key
	my $right = shift;		# right address in the key
	my $agent_host = shift;
	my $proto = shift;
	my $status = shift;
	my $left_type;		# type of the left address (ip-address/domain name)
	my $right_type;		# type of the right address (ip-address/domain name)

	if( $key =~ /^(a.{4}|d\S+)\s(a.{4}|d\S+)\s(\S+)\s(\S+)\s(\S+)/so ){
		$left_type = substr( $1, 0, 1 );
		$right_type = substr( $2, 0, 1 );
		if( $left_type eq 'a' ){
			# get ip addresses and domain names if possible:
			$left->{'addr'} = substr( $1, 1 );
			$left->{'symbolic_addr'} = inet_ntoa( $left->{'addr'} );
			$left->{'symbolic_name'} = resolve( $left->{'addr'} );
			$left->{'name'} = compile_domain( $left->{'symbolic_name'} );
		}elsif( $left_type eq 'd' ){
			$left->{'addr'} = '';
			$left->{'symbolic_addr'} = '';
			$left->{'name'} = substr( $1, 1 );
			$left->{'symbolic_name'} = compile_domain( $left->{'name'} );	# flip back
		}else{
			print STDERR "Bad address type: \"$1\" in record!\n";
			return 0;
		}
		if( $right_type eq 'a' ){
			# get ip addresses and domain names if possible:
			$right->{'addr'} = substr( $2, 1 );
			$right->{'symbolic_addr'} = inet_ntoa( $right->{'addr'} );
			$right->{'symbolic_name'} = resolve( $right->{'addr'} );
			$right->{'name'} = compile_domain( $right->{'symbolic_name'} );
		}elsif( $right_type eq 'd' ){
			$right->{'addr'} = '';
			$right->{'symbolic_addr'} = '';
			$right->{'name'} = substr( $2, 1 );
			$right->{'symbolic_name'} = compile_domain( $right->{'name'} );	# flip back
		}else{
			print STDERR "Bad address type: \"$2\" in record!\n";
			return 0;
		}
		$$agent_host = $3;
		$$proto = $4;
		$$status = $5;
		return 1;
	}else{
		print STDERR "Bad key \"$key\" in record!\n";
		return 0;
	}
}


# Process a single table
# Arguments:
# - database handle
# - reference to a table structure (see compile_tables() for details)
# - reference to a list of start keys of host ranges (as produced by
#   range_keys_catexp())
# - traffic direction ('to'|'from')
#
sub process_table
{
	my $db = shift;		# database handle
	my $table = shift;	# a table to process
	my $start_keys = shift;	# reference to array of start points of address
				# ranges that make up a table category
	my $dir = shift;	# traffic direction ('to'|'from')
	my $i;			# loop counter
	my $column;		# loop variable (a column of a table)
	my @found_rows;		# found table row headers for a given category
				# expression
	my $row;		# a table row header
	my ( $key, $value );	# db key and value
	my $items;		# number of items (packets/messages/requests)
	my $bytes;		# number of bytes
	my $units;		# number of either bytes or items depending on
				# comlumn's option
	my $agent_host;		# host from which statistics is fetched
	my $proto;		# protocol (ip/http/smtp/nntp/...)
	my $status;		# request/packet/message status
	my ( %host1, %host2 );	# hashes that contain info about source and
				# destination ( have keys 'symbolyc', 'addr'
				# and 'name'; 'addr' is used only for ip
				# addresses, 'name' - for given domain names
				# and names resolved from addresses).
	my $inrange;		# flag, whether the record is still in range of
				# a group
	my $seq_status;		# status of the seq operation
	my $start_range;	# flag: 1 when it is the first access for the
				# current range, 0 otherwise
	my $current_line_num = 0;
	my $key_index = 0;	# index of a current @$start_keys list element

	foreach( @$start_keys ){	# loop by key ranges

		$key = $_;
		$inrange = 1;
		$start_range = 1;

		while( $inrange ){	# loop by records within a range

			if( $start_range ){
				$seq_status = $db->seq( $key, $value, R_CURSOR );
				$start_range = 0;
			}else{
				$seq_status = $db->seq( $key, $value, R_NEXT );
			}
			unless( $seq_status == 0 ){
				if( $seq_status == -1 ){
					print STDERR "Database access error: $!\n";
				}
				last;
			}
			$current_line_num++;
			if( $opt_v && int($current_line_num/100)*100 == $current_line_num ){
				printf STDERR "$current_line_num\r";
			}

			process_key( $key, \%host1, \%host2, \$agent_host, \$proto, \$status ) || next;
			( $items, $bytes ) = split / /, $value;

			# counting traffic units according to category and column categories:
			if( ( $key_index == $#$start_keys
			|| $key lt $start_keys->[ $key_index + 1 ] )
				# this condition prevents from counting traffic
				# more than once for the key ranges that happened
				# to be adjacent in the database.
			&& ( @found_rows = cmp_host_catexp( $table->[ 1 ], \%host1, $table->[ 3 ], 1 ) ) ){
				$i = 0;
				foreach $column ( @{$table->[ 4 ]} ){
					if( cmp_tag_taglist( $column->[ 4 ], $agent_host )
					&& cmp_tag_taglist( $column->[ 5 ], $proto )
					&& cmp_tag_taglist( $column->[ 6 ], $status )
					&& $column->[ 2 ] =~ /^both|$dir$/
					&& cmp_host_catexp( $column->[ 1 ], \%host2, 0, 0 ) ){

						$units = $column->[ 3 ] eq 'items' ? $items : $bytes;
						foreach $row ( @found_rows ){
							$table->[ 6 ]->{$row}->[ $i ] += $units;
						}
						$table->[ 7 ]->[ $i ] += $units;	# TOTAL
					}
					$i++;
				}
			}else{
				$inrange = 0;
			}
		}
		$key_index++;
	}
}


# Process all tables
#
sub process_report
{
	my $table;		# loop variable (a table)
	my %from_acctdb;	# db table containing data sorted by traffic sources
	my %to_acctdb;		# db table containing data sorted by traffic destinations
	my $from_db;
	my $to_db;
	my $start_keys;		# reference to array of start points of address
				# ranges that make up a table category
	my $column;		# loop variable (a table column)
	my $any_to = 0;		# flag: does a table contain any column for
				# incoming traffic
	my $any_from = 0;	# flag: does a table contain any column for
				# outgoing traffic

	$from_db = tie( %from_acctdb, 'DB_File', "$opt_d.from.db", O_RDONLY, 0644, $DB_BTREE ) || die "Can\'t tie $opt_d.from.db database: $!";
	$to_db = tie( %to_acctdb, 'DB_File', "$opt_d.to.db", O_RDONLY, 0644, $DB_BTREE ) || die "Can\'t tie $opt_d.to.db database: $!";

	print STDERR "Number of records processed:\n" if $opt_v;
	# do accounting for each of the tables:
	foreach $table ( @{$tables{$traffic_type}} ){

		# Determine which of the directions we need to pass through
		# for the table:
		foreach $column ( @{$table->[ 4 ]} ){
			if( $column->[ 2 ] eq 'to' ){
				$any_to = 1;
			}elsif( $column->[ 2 ] eq 'from' ){
				$any_from = 1;
			}else{	# 'both'
				$any_from = $any_to = 1;
			}
			last if $any_from && $any_to;
		}

		$start_keys = range_keys_catexp( $table->[ 1 ] );

		if( $any_to ){
			if( $opt_v ){
				printf STDERR "\nTable \"$table->[ 0 ]\"\n\tIncoming traffic:\n";
			}
			process_table( $to_db, $table, $start_keys, 'to' );
		}
		if( $any_from ){
			if( $opt_v ){
				printf STDERR "\n\tOutgoing traffic:\n";
			}
			process_table( $from_db, $table, $start_keys, 'from' );
		}
	}
	print STDERR "\nComplete\n" if $opt_v;

	undef $from_db;
	undef $to_db;
	untie %from_acctdb;
	untie %to_acctdb;
}


###########################################################################
# Printing procedures
###########################################################################

# Print report
#
sub print_report
{
	my $table;			# cycle variable (a table)
	my $column;			# cycle variable (a column of a table)
	my $rows;			# hash of row headers for each table
	my $i;				# cycle counters
	my $summary;			# reference to list of column summaries
	my @width;			# width of each column
	my $skip;			# flag: whether to skip the row while printing table
	my $header_column_width;	# 'Host Groups' column width
	my $sorted;			# cycle variable (a sorted group)
	my $mult;			# multiplier

	print "<HTML>\n<BODY BGCOLOR=\"#50A0A0\" TEXT=YELLOW>\n" if $opt_h;

	foreach $table ( @{$tables{$traffic_type}} ){

		$rows = $table->[ 6 ];
		$summary = $table->[ 7 ];
		@width = ();

		# computing groups column width:
		$header_column_width = 0;
		foreach ( keys( %$rows ), 'TOTAL', 'Host Groups' ){
			$header_column_width = $header_column_width > length( $_ ) ? $header_column_width : length( $_ );
		}

		# computing each column width:
		$i = 0;
		foreach $column ( @{$table->[ 4 ]} ){
			if( lc( $column->[ 3 ] ) eq 'kbytes' ){
				$mult = 1024;
			}elsif( lc( $column->[ 3 ] ) eq 'mbytes' ){
				$mult = 1024 * 1024;
			}elsif( lc( $column->[ 3 ] ) eq 'gbytes' ){
				$mult = 1024 * 1024 * 1024;
			}else{	# 'bytes'
				$mult = 1;
			}
			$width[ $i ] = length( $column->[ 0 ] );
			foreach ( keys %$rows ){
				# recalculating in kilobytes rather than in bytes:
				$rows->{$_}->[ $i ] = ( defined $rows->{$_}->[ $i ]
							? round_float( ( ( $rows->{$_}->[ $i ] ) / $mult ), $table->[ 5 ] )
							: 0 );
				$width[ $i ] = length( $rows->{$_}->[ $i ] ) if $width[ $i ] < length( $rows->{$_}->[ $i ] );
			}
			$summary->[ $i ] = ( defined $summary->[ $i ]
						? round_float( ( ( $summary->[ $i ] ) / $mult ), $table->[ 5 ] )
						: 0 );
			$width[ $i ] = length( $summary->[ $i ] ) if $width[ $i ] < length( $summary->[ $i ] );
			$i++;
		}

		if( $opt_h ){
			print "\n<P><H4>", $table->[ 0 ], ":</H4>\n<TABLE BORDER>\n<TR>";
		}else{
			print "\n", $table->[ 0 ], ":";
		}
		print_horiz_border( $header_column_width, @width );

		# table headers:
		print_cell( 'Host Groups', $header_column_width, 1, 1 );
		$i = 0;
		foreach $column ( @{$table->[ 4 ]} ){
			print_cell( $column->[ 0 ], $width[ $i ], 0, 1 );
			$i++;
		}

		print_horiz_border( $header_column_width, @width );

		# making the sort column number and the table's groups hash
		# available for table_sort():
		$sort_column = $table->[ 2 ];
		$table_rows = $rows;

		# table body:
		foreach $sorted ( sort table_sort keys %$rows ){

			# skipping null rows:
			$skip = 1;
			$i = 0;
			foreach ( @{$table->[ 4 ]} ){
				if( $rows->{$sorted}->[ $i ] != 0 ){ $skip = 0; }
				$i++;
			}
			next if $skip;

			# printing a row:
			print_cell( $sorted, $header_column_width, 1, 0 );
			$i = 0;
			foreach $column ( @{$table->[ 4 ]} ){
				print_cell( $rows->{$sorted}->[ $i ], $width[ $i ], 0, 0 );
				$i++;
			}
		}

		print_horiz_border( $header_column_width, @width );

		# summary:
		print_cell( 'TOTAL', $header_column_width, 1, 0 );
		$i = 0;
		foreach $column ( @{$table->[ 4 ]} ){
			print_cell( $summary->[ $i ], $width[ $i ], 0 );
			$i++;
		}

		print_horiz_border( $header_column_width, @width );
		if( $opt_h ){
			print "\n</TR>\n</TABLE>\n";
		}else{
			print "\n";
		}
	}
	print "</BODY>\n</HTML>\n" if $opt_h;
}


# Print a table cell.
# Arguments:
# - cell content
# - cell width
# - flag: 1 if cell is in the first column; 0 otherwize
# - flag: 1 if cell is in the first row; 0 otherwize
#
sub print_cell
{
	my $bg;
	my $fg;
	my $td;

	if( $_[ 2 ] ){
		if( $opt_h ){
			print "\n</TR>\n<TR>" unless $_[ 3 ]; 
			$bg = $_[ 3 ] ? "WHITE" : "ORANGE";
			$fg = $_[ 3 ] ? "ORANGE" : "BLACK";
			print "\n	<TH ALIGN=RIGHT BGCOLOR=$bg><FONT COLOR=$fg>$_[ 0 ]</FONT></TH>";
		}else{
			printf( "\n| %*.*s |", $_[ 1 ], $_[ 1 ], $_[ 0 ] );
		}
	}else{
		if( $opt_h ){
			$bg = $_[ 3 ] ? "ORANGE" : "WHITE";
			$fg = $_[ 3 ] ? "WHITE" : "BLACK";
			$td = $_[ 3 ] ? "TH" : "TD";
			print "\n	<$td ALIGN=RIGHT BGCOLOR=$bg><FONT COLOR=$fg>$_[ 0 ]</FONT></$td>";
		}else{
			printf( " %*.*s |", $_[ 1 ], $_[ 1 ], $_[ 0 ] );
		}
	}
}


# Draw horizontal border.
# Arguments:
# - width of Groups column
# - list of column widths
#
sub print_horiz_border
{
	my $i;

	unless( $opt_h ){
		print "\n+";
		foreach ( @_ ){
			print '-';
			for( $i = 0; $i < $_; $i++ ){
				print '-';
			}
			print '-+';
		}
	}
}


# Print usage information.
#
sub print_usage
{

print <<END

Usage:

AcctLog	[-v] [-h] -d <dbfile> [-f <conffile>] <traffic_type>

-v		# print progress information
-h		# generate reports in HTML
-d <dbfile>	# database file to read data from
-f <conffile>	# configuration file
<traffic_type>	# type of traffic to compute
END

}


###########################################################################
# Configuration procedures
###########################################################################

# Parse the command line
# Arguments - command line options
#
sub config_cmdline
{
	my $i;				# cycle counter
	my $optname;			# cmdline option name

	for( $i = 0; $i < @_ ; $i++ ){
		if( $_[ $i ] eq '-v' ){
			$opt_v = 1;
		}elsif( $_[ $i ] eq '-h' ){
			$opt_h = 1;
		}elsif ( $_[ $i ] =~ /^-(d|f)$/ ){
			$optname = $1;
			if( $_[ $i + 1 ] =~ /^[^-]\S*$/ ){
				${"opt_$optname"} = $_[ $i + 1 ];
				$i++;
			}else{
				print_usage();
				exit;
			}
		}elsif( !defined $traffic_type ){
			$traffic_type = $_[ $i ];
		}else{
			print_usage();
			exit;
		}
	}

	unless( defined $opt_d && defined $traffic_type ){
		print_usage();
		exit;
	}
}


# Suck in the configuration file:
#
sub config_file
{
	push @INC, '/usr/local/etc/tas';
	require ( defined $opt_f ? $opt_f : 'AcctLog.conf' );
}


# main()

config_cmdline( @ARGV );
config_file();
compile_local_nets();
compile_lists();
compile_tables();
process_report();
print_report();

# end of main()



