File Coverage

blib/lib/SyslogScan/DeliveryIterator.pm

Criterion	Covered	Total	%
statement	4	7	57.1
branch			n/a
condition			n/a
subroutine	2	3	66.6
pod			n/a
total	6	10	60.0

# DeliveryIterator: an object which scans a syslog for
# successful sendmail deliveries.

# TODO: add documentation
# TODO: use undef value rather than END_OF_TIME

package main;

require 'timelocal.pl';

package SyslogScan::DeliveryIterator;

$VERSION = 0.30;
sub Version { $VERSION };

use SyslogScan::Delivery;
use SyslogScan::SendmailUtil;
use SyslogScan::ParseDate;

use Carp;
use strict;

# internal subroutines
my ($pValidateRule, $pParseDate);

# time_t start and end values
my $END_OF_TIME = 4294967295;  #  2 ** 32 - 1;
my $START_OF_TIME = 0;

sub new
{
    my $type = shift;
    my %deliveryRule = @_;

    my $Rule = {};
    my $self = { Rule => $Rule,
	     seenFromLine => {},
	     syslogList => [] };

    bless $self, $type;

    &$pValidateRule(\%deliveryRule);

    $$Rule{startDate} = $deliveryRule{startDate} || $START_OF_TIME;
    $$Rule{endDate} = $deliveryRule{endDate} || $END_OF_TIME;

    $$Rule{unknownSender} = $deliveryRule{unknownSender};
    $$Rule{unknownSize} = $deliveryRule{unknownSize};

    # User should call setDefaultYear() directly instead of through here.
    # But, for backwards compatibility:
    if (defined $deliveryRule{defaultYear})
    {
	&SyslogScan::ParseDate::setDefaultYear($deliveryRule{defaultYear});
	warn "setting default year in DeliveryIterator deprecated"
	    unless $::gbQuiet;
    }
    # $$Rule{defaultYear} = $deliveryRule{defaultYear};

    $$Rule{startDate} = &SyslogScan::ParseDate::parseDate($$Rule{startDate});
    $$Rule{endDate} = &SyslogScan::ParseDate::parseDate($$Rule{endDate});

    # $$Rule{startDate} = &$pParseDate($$Rule{startDate});
    # $$Rule{endDate} = &$pParseDate($$Rule{endDate});

    my $paFileName = $deliveryRule{syslogList};
    if (defined $paFileName)
    {
	ref($paFileName) eq "ARRAY" or
	    die "fileNameList is not an array, stopped";
	my $fileName;

	foreach $fileName (@$paFileName)
	{
	    $self -> appendSyslog($fileName);
	}
    }

    return $self;
}

sub next
{
    my $self = shift;
    my $fh;

    return $self -> _nextInFileHandle($fh)
	if defined($fh = shift);

    while (1)
    {
	if (!$$self{fileHandle})
	{
	    my $fileName = shift(@{$$self{syslogList}});
	    defined($fileName) or return undef;

	    open(SYSLOG,$fileName) or die "could not open $fileName: $!";
	    $$self{fileHandle} = \*SYSLOG;
	}
	my $next = $self -> _nextInFileHandle($$self{fileHandle});
	return $next if defined($next);
	close($$self{fileHandle});
	undef($$self{fileHandle});
    }
    die;
}

sub appendSyslog
{
    my $self = shift;
    my $fileName = shift;

    push(@{$$self{syslogList}},$fileName);
    return 0;
}

sub _transferToDelivery
{
    my $self = shift;
    my $pLogLine = shift;

    my $pRule = $$self{Rule};

    my $lineClass = ref $pLogLine;
    die "sanity check of class failed for $lineClass"
	unless ($lineClass =~ /^SyslogScan::SendmailLine/);

    my $date = "$$pLogLine{month} $$pLogLine{day} " .
	"$$pLogLine{'time'}";

    my $dateValue = $pLogLine -> unix_time;
    # my $dateValue = &$pParseDate($date, $$pRule{defaultYear});
    die "invalid date and time: $date" unless $dateValue > 0;

    defined $$pRule{endDate} || die "no start date defined";
    if ($dateValue > $$pRule{endDate})
    {
	return undef;
    }

    # for debugging purposes
    my $id = $$pLogLine{'messageID'};

    if ($lineClass =~ /From/)
    {
	$self -> _storeFromLine($pLogLine);
	return undef;
    }

    if ($lineClass =~ /Clone/)
    {
	$self -> _storeCloneLine($pLogLine);
	return undef;
    }

    if ($dateValue < $$pRule{startDate})
    {
	return undef;
    }

    my $pAttrHash = $$pLogLine{'attrHash'};
    die "could not access hash" unless defined $pAttrHash;
    return undef unless ($$pAttrHash{'stat'} =~ /^Sent/);

    my @receiverList = @{$$pLogLine{'toList'}};

    my $instance = $self -> _recallInstanceAndIncrement($pLogLine);
    my $size = $self -> _recallSize($pLogLine);
    my $sender = $self -> _recallSender($pLogLine);

    if (! defined $size)
    {
	#never saw the associated From: line
	print STDERR "could not find sender for msg id $id to @receiverList\n"
	    unless $::gbQuiet;
	$size = $$pRule{unknownSize};      # may be undefined
	$sender = $$pRule{unknownSender};  # may be undefined
    }

    return new SyslogScan::Delivery ( Date => $date,
				     Size => $size,
				     Id => $id,
				     Sender => $sender,
				     ReceiverList => \@receiverList,
				     Instance => $instance );
}


sub _nextInFileHandle
{
    my $self = shift;
    my $fh = shift;

    my $pLogLine;
    while ($pLogLine = &SyslogScan::SendmailUtil::getNextMailTransfer($fh))
    {
	my $delivery = $self -> _transferToDelivery($pLogLine);
	return $delivery if defined($delivery);
    }
    return undef;  #at EOF
}

# internal routines for storing and retrieving the information
#   in 'From:' lines.

# A 'mini-fromline' is a three-element array of (size, sender,
# instance), which stores the all the information we need about a
# formerly-seen from-line in a compact form.  By putting it in a
# compact form, the already-seen table only takes up about 2 mb in our
# environment when chomping through 3 days of mail, rather than 20 mb
# or more like it would take up if we stored the full SendmailLineFrom
# object.

sub _storeFromLine
{
    my $self = shift;
    my $pFromLine = shift;

    my $pSeenFromLine = $$self{seenFromLine};
    my $pFromHash = $$pFromLine{attrHash};
    my $id = $$pFromLine{messageID};

    my $miniFromLine;
    if (defined $$pSeenFromLine{$id})
    {
	print STDERR "already saw from-line with id $id\n"
	    unless $::gbQuiet;

	# We should probably use a Rule same as for messages where
	# the sender is unknown... but, this does not happen very
	# often, so no big deal.
	$miniFromLine = [0,"duplicate",0];
    }
    else
    {
        # to save on memory, we do not store the whole line
	$miniFromLine = [ $$pFromHash{'size'}, $$pFromHash{'from'},0 ];
    }
    $$pSeenFromLine{$id} = $miniFromLine;
}

sub _storeCloneLine
{
    my $self = shift;
    my $pCloneLine = shift;

    my $pSeenFromLine = $$self{seenFromLine};
    my $id = $$pCloneLine{messageID};

    my $miniFromLine;
    if (defined $$pSeenFromLine{$id})
    {
	print STDERR "already saw from-line with id $id\n"
	    unless $::gbQuiet;
	$miniFromLine = [0,"duplicate",0];
    }
    else
    {
	my $originalID = $$pCloneLine{clonedFrom};
	defined($originalID) || die "originalID undefined for ID $id";
	$miniFromLine = $$pSeenFromLine{$originalID};
    }
    $$pSeenFromLine{$id} = $miniFromLine;
}

sub _getIncrementAmount
{
    my $self = shift;
    my $pToLine = shift;
    my $receiverCount = @{$$pToLine{'toList'}};
    die "no receivers" unless $receiverCount > 0;
    return $receiverCount;
}

sub _recallFromLine
{
    my $self = shift;
    my $pToLine = shift;

    my $id = $$pToLine{messageID};
    my $pSeenFromLine = $$self{seenFromLine};
    my $miniFromLine = $$pSeenFromLine{$id};

    return $miniFromLine;   # undefined if we did not see from-line
}

sub _recallSize
{
    my $self = shift;
    my $fromLine = $self -> _recallFromLine(@_);
    return $$fromLine[0];
}

sub _recallSender
{
    my $self = shift;
    my $fromLine = $self -> _recallFromLine(@_);
    return $$fromLine[1];
}

sub _recallInstanceAndIncrement
{
    my $self = shift;
    my $fromLine = $self -> _recallFromLine(@_);
    my $incrementAmount = $self -> _getIncrementAmount(@_);

    $$fromLine[2] = 0 if ! defined($$fromLine[2]);
    $$fromLine[2] += $incrementAmount;

    #instance number starts at 1
    return $$fromLine[2] + 1 - $incrementAmount;
}

my $ONE_MONTH = 30*24*60*60;
my $ELEVEN_MONTH = 11 * $ONE_MONTH;

my @LEGAL_KEY_LIST = qw( startDate endDate syslogList unknownSender
			unknownSize defaultYear );

$pValidateRule = sub {
    my $rule = shift;
    my $myKey;
    foreach $myKey (keys %$rule)
    {
	confess("illegal key for delivery rule: $myKey")
	    unless grep ($_ eq $myKey, @LEGAL_KEY_LIST);

	# sanity check
	die "internal error: wrong kind of reference"
	    unless $myKey
    }
};

my @gMonthList = qw ( jan feb mar apr may jun jul aug sep oct nov dec );
my %gMonthTable = ();
my ($i, $month);
foreach $month (@gMonthList)
{
    $gMonthTable{$month} = $i++;
}

1;

__END__