File Coverage

blib/lib/Mail/Log/Parse/Postfix.pm

Criterion	Covered	Total	%
statement	87	87	100.0
branch	14	14	100.0
condition	3	3	100.0
subroutine	16	16	100.0
pod	2	2	100.0
total	122	122	100.0

#!/usr/bin/perl

package Mail::Log::Parse::Postfix;
{
=head1 NAME

Mail::Log::Parse::Postfix - Parse and return info in Postfix maillogs

=head1 SYNOPSIS

  use Mail::Log::Parse::Postfix;

(See L for more info.)

=head1 DESCRIPTION

This is a subclass of L, which handles parsing for
Postfix mail logs.

=head1 USAGE

=cut

use strict;
use warnings;
use Scalar::Util qw(refaddr);
use Time::Local;
use Mail::Log::Parse 1.0400;
use Mail::Log::Exceptions;
use base qw(Mail::Log::Parse Exporter);

use Memoize;
memoize('timelocal');

BEGIN {
    use Exporter ();
    use vars qw($VERSION);
    $VERSION     = '1.0501';
}

# A constant, to convert month names to month numbers.
my %MONTH_NUMBER = (	Jan		=> 0
						,Feb	=> 1
						,Mar	=> 2
						,Apr	=> 3
						,May	=> 4
						,Jun	=> 5
						,Jul	=> 6
						,Aug	=> 7
						,Sep	=> 8
						,Oct	=> 9
						,Nov	=> 10
						,Dec	=> 11
					);

# We are going to assume we are only run once a day.  (Actually, since we only
# ever use the _year_...)
my @CURR_DATE = localtime;

#
# Define class variables.  Note that they are hashes...
#

my %log_info;

#
# DESTROY class variables.
#
### IF NOT DONE THERE IS A MEMORY LEAK.  ###

sub DESTROY {
	my ($self) = @_;

	delete $log_info{$$self};

	$self->SUPER::DESTROY();

	return;
}

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

	my $self = $class->SUPER::new($parameters_ref);

	if (defined($parameters_ref->{year})) {
		$self->set_year($parameters_ref->{year});
	}

	return $self
}

=head2 set_year

Sets the year, for the log timestamps.  If not set, the log is assumed to
be for the current year.  (Can also be passed in C, with the key 'year'.)

=cut

sub set_year {
	my ($self, $year) = @_;
	$log_info{refaddr $self}->{year} = $year;
	$self->_clear_buffer();
	return
}

=head2 next

Returns a hash of the next line of postfix log data.

Hash keys are:

	delay_before_queue, delay_connect_setup, delay_in_queue,
	delay_message_transmission, from, host, id, msgid, pid, program,
	relay, size, status, text, timestamp, to, delay, connect,
	disconnect, previous_host, previous_host_name, previous_host_ip

All keys are guaranteed to be present.  'program', 'pid', 'host', 'timestamp',
'id' and 'text' are guaranteed to have a value.  'connect' and 'disconnect' are
boolean: true if the line is the relevant type of line, false otherwise.

The 'text' key will have all of the log text B the standard Postfix
header.  (All of which is in the other keys that are required to have a value.)

=cut

sub _parse_next_line {
#	my ($self) = @_;	# Saves a couple of microseconds per call not to use $self.
						# Given the _extreme_ amounts this method is called,
						# I thought it worth the trade-off.  $_[0] == $self

	# The hash we will return.
	my %line_info = ( program => '' );

	# Some temp variables.
	my $line;
	my @line_data;

	# In a mixed-log enviornment, we can't count on any particular line being
	# something we can parse.  Keep going until we can.
	while ( $line_info{program} !~ m/postfix/ ) {
		# Read the line.
		$line = $_[0]->_get_data_line() or return undef;

		# Start parsing.
		@line_data = split ' ', $line, 7;

		no warnings qw(uninitialized);
		# Program name and pid.
		($line_info{program}, $line_info{pid}) = $line_data[4] =~ m/([^[]+)\[(\d+)\]/;
	}

	# First few fields are the date.  Convert back to Unix format...
	{	# We don't need all these temp variables hanging around.
		my ($log_hour, $log_minutes, $log_seconds) = split /:/, $line_data[2];
		if (!defined($log_info{${$_[0]}}->{year}) ) {
			$line_info{timestamp} = timelocal($log_seconds, $log_minutes, $log_hour, $line_data[1], $MONTH_NUMBER{$line_data[0]}, $CURR_DATE[5]);
		}
		else {
			$line_info{timestamp} = timelocal($log_seconds, $log_minutes, $log_hour, $line_data[1], $MONTH_NUMBER{$line_data[0]}, $log_info{${$_[0]}}->{year});
		}
	}

	# Machine Hostname
	$line_info{host} = $line_data[3];

	# Connection ID
	if ( $line_data[5] =~ m/([^:]+):/ ) {
		$line_info{id} = $1;
	}
	else {
		$line_info{id} = undef;
	}

	# The full rest is given as text.
	if (defined($line_info{id})) {
		$line_info{text} = $line_data[6];
	}
	else {
		$line_info{text} = join ' ', @line_data[5..$#line_data];
	}
	chomp $line_info{text};

	# Stage two of parsing.
	# (These may or may not return any info...)

	# To address
	@{$line_info{to}} = $line_info{text} =~ m/\bto=([^,]+),/g;

	if ( defined($line_info{to}[0]) ) {
		# Relay
		($line_info{relay}) = $line_info{text} =~ m/\brelay=([^,]+),/;

		# Delays
		($line_info{delay_before_queue}, $line_info{delay_in_queue}, $line_info{delay_connect_setup}, $line_info{delay_message_transmission} )
			= $line_info{text} =~ m{\bdelays=([^/]+)/([^/]+)/([^/]+)/([^,]+),};
		($line_info{delay}) = $line_info{text} =~ m/\bdelay=([\d.]+),/;

		# Status
		($line_info{status}) = $line_info{text} =~ m/\bstatus=(.+)\Z/;

		@line_info{'from', 'size', 'msgid', 'connect', 'disconnect', 'previous_host'
					, 'previous_host_name', 'previous_host_ip' } = undef;
	}
	else {
		# From address
		($line_info{from}) = $line_info{text} =~ m/\bfrom=([^,]+),/;

		# Size
		($line_info{size}) = $line_info{text} =~ m/\bsize=([^,]+),/;

		# Message ID
		($line_info{msgid}) = $line_info{text} =~ m/\bmessage-id=(.+)$/;

		# Connect (Boolean)
		$line_info{connect} = $line_info{text} =~ m/\bconnect from/;

		# Disconnect (Boolean)
		$line_info{disconnect} = $line_info{text} =~ m/\bdisconnect from/;

		# Remote host info.  (Only if above.)
		if ( $line_info{connect} || $line_info{disconnect} ) {
			($line_info{previous_host}) = $line_info{text} =~ m/connect from (\S+)/;
			($line_info{previous_host_name}, $line_info{previous_host_ip})
				= $line_info{previous_host} =~ m/([^[]+)\[([^\]]+)\]/;
		}
		else {
			@line_info{'previous_host', 'previous_host_name', 'previous_host_ip'} = undef;
		}

		@line_info{'relay', 'status', 'delay_before_queue', 'delay_in_queue'
					, 'delay_connect_setup', 'delay_message_transmission', 'delay'}
					= undef;
	}

	# Return the data.
	return \%line_info;
}

=head1 BUGS

None known at the moment.

=head1 REQUIRES

L, L, L, L,
L

=head1 AUTHOR

Daniel T. Staal

[e-mail]

=head1 SEE ALSO

L, for the main documentation on this module set.

=head1 HISTORY

April 17, 2009 (1.5.1) - No longer uses C<_set_current_position_as_next_line>,
instead lets Mail::Log::Parse manage automatically.  (Requires 1.4.0.)

April 9, 2009 (1.5.0) - Now reads the connecting host from the 'connect' and
'disconnect' lines in the log.

Feb 27, 2009 (1.4.12) - Quieted an occasional error, if the log line doesn't
have the standard Postfix format.

Dec 23, 2008 (1.4.11) - Further speedups.  Now requires Mail::Log::Parse of at
least version 1.3.0.

Dec 09, 2008 (1.4.10) - Profiled code, did some speedups.  Added dependency on
Memoize: For large logs this is a massive speedup.  For extremely sparse logs
it may not be, but sparse logs are likely to be small.

Nov 28, 2008 - Switched 'total_delay' to slightly more universal 'delay'.
Sped up some regexes.

Nov 11, 2008 - Switched to using the bufferable C<_parse_next_line> instead of
the unbuffered C.

Nov 6, 2008 - Added C and alternate year handling, in case we aren't
dealing with this year's logs.  (From the todo list.)

Oct 24, 2008 - Added 'connect' and 'disconnect' members to the return hash.

Oct 6, 2008 - Initial version.

=head1 COPYRIGHT and LICENSE

Copyright (c) 2008 Daniel T. Staal. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

This copyright will expire in 30 years, or 5 years after the author's
death, whichever is longer.

=cut

# End module package.
}
1;