File Coverage

blib/lib/Mail/Exim/MainLogParser.pm

Criterion	Covered	Total	%
statement	22	58	37.9
branch	0	14	0.0
condition	1	26	3.8
subroutine	7	10	70.0
pod	3	3	100.0
total	33	111	29.7

package Mail::Exim::MainLogParser;
use strict;

BEGIN {
    use Exporter ();
    use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
    $VERSION     = '0.01';
    @ISA         = qw(Exporter);
    @EXPORT      = qw();
    @EXPORT_OK   = qw(&EximMainLoglineParse);
    %EXPORT_TAGS = ();
}

BEGIN {
  use vars      qw(%EXIM_FLAGS %EXIM_FIELD_IDENFIERS);

  # As of 2017-06-08
  # Source: http://www.exim.org/exim-html-current/doc/html/spec_html/ch-log_files.html
  %EXIM_FLAGS = (
	'<='	=>	'message arrival',
	'(='	=>	'message fakereject',
	'=>'	=>	'normal message delivery',
	'->'	=>	'additional address in same delivery',
	'>>'	=>	'cutthrough message delivery',
	'*>'	=>	'delivery suppressed by -N',
	'**'	=>	'delivery failed; address bounced',
	'=='	=>	'delivery deferred; temporary problem',
  );
  %EXIM_FIELD_IDENFIERS = (
	A	=>	'authenticator name (and optional id and sender)',
	C	=>	('SMTP confirmation on delivery'.			'; '.
			'command list for "no mail in SMTP session”'),
	CV	=>	'certificate verification status',
	D	=>	'duration of "no mail in SMTP session”',
	DN	=>	'distinguished name from peer certificate',
	DS	=>	'DNSSEC secured lookups',
	DT	=>	'on => lines: time taken for a delivery',
	F	=>	'sender address (on delivery lines)',
	H	=>	'host name and IP address',
	I	=>	'local interface used',
	K	=>	'CHUNKING extension used',
	id	=>	'message id for incoming message',
	P	=>	('on <= lines: protocol used'. 				'; '.
			'on => and ** lines: return path'),
	PRDR	=>	'PRDR extension used',
	PRX	=>	'on <= and => lines: proxy address',
	Q	=>	'alternate queue name',
	QT	=>	('on => lines: time spent on queue so far'. 		'; '.
			'on "Completed” lines: time spent on queue'),
	R	=>	('on <= lines: reference for local bounce'. 		'; '.
			'on =>  >> ** and == lines: router name'),
	S	=>	'size of message in bytes',
	SNI	=>	'server name indication from TLS client hello',
	ST	=>	'shadow transport name',
	T	=>	('on <= lines: message subject (topic)'. 		'; '.
			'on => ** and == lines: transport name'),
	U	=>	'local user or RFC 1413 identity',
	X	=>	'TLS cipher suite'
    );
}


sub new
{
    my ($class, %parameters) = @_;

    my $self = bless ({}, ref ($class) || $class);

    return $self;
}

sub _exim_log_main__parse($) {
  my $line = shift || return undef;
  my @line = split(/\s/,$line);
  return undef unless scalar @line >= 3;
  my $l = {
    date => shift @line,
    time => shift @line
  };

  # Exim ID: 1dIyz2-0002mc-5x
  if ($line[0] =~ /......\-......\-../) {
    $l->{eximid} = shift @line;
  } else {
    $l->{eximid} = undef;
  }

  # Exim log line flag
  if ($line[0] =~ /\<\=|\(\=|\=\>|\-\>|\>\>|\*\>|\*\*|\=\=/) {
    $l->{flag} = shift @line;
  } else {
    # mail rejected or completed!
    $l->{flag} = undef;
  }

  # Exim Mail Address
  if (($line[0] !~ /^[A-Zid]{1,4}\=.+/) && ($line[0] =~ /.+\@.+/)) {
    $l->{address} = shift @line;
    while ((defined $line[0]) && ($line[0] !~ /^[A-Zid]{1,4}\=.+/)) {
      if ( ((!defined $l->{flag}) || ((defined $l->{flag}) && ($l->{flag} eq '**'))) && ($l->{address} =~ /\:$/)) {
        chop $l->{address};
        last;
      }
      $l->{address} .= (" " . shift @line);
    }
  }

  # Exim field identifiers and messages
  $l->{args} = [];
  while (scalar @line >= 1) {
    if ($line[0] =~ /^([A-Zid]{1,4})\=(.+)/) {
      my $this_arg = $1;
      my $this_val = $2;
      shift @line;
      while ( (scalar @line >= 1) && (($line[0] =~ /^\[.+\]/) || ($line[0] =~ /^\(.+\)/)) ) {
        $this_val .= (" " . shift @line);
      }
      push(@{$l->{args}},{$this_arg => $this_val});
    } else {
      $l->{message} = shift @line;
      while ((defined $line[0]) && ($line[0] !~ /^[A-Zid]{1,4}\=.+/)) {
        $l->{message} .= (" " . shift @line);
      }
    }
  }

  if (scalar @line >= 1) {
    die ("Error Parsing Line: $line\n"."Unparsed log line data: ".join("; ",@line)."\n");
  }

  return $l;
}

sub EximMainLoglineParse($) {
  return _exim_log_main__parse($_[0]);
}

sub parse($) {
  my $self = shift;
  return _exim_log_main__parse($_[0]);
}

1;
__END__