File Coverage

blib/lib/IPTables/Log.pm

Criterion	Covered	Total	%
statement	26	36	72.2
branch	1	4	25.0
condition			n/a
subroutine	9	13	69.2
pod	2	7	28.5
total	38	60	63.3

#!/usr/bin/perl

#=======================================================================
# Log.pm / IPTables::Log
# $Id: Log.pm 21 2010-12-17 21:07:37Z andys $
# $HeadURL: https://daedalus.dmz.dn7.org.uk/svn/IPTables-Log/trunk/IPTables-Log/lib/IPTables/Log.pm $
# (c)2009 Andy Smith
#-----------------------------------------------------------------------
#:Description
# This is the main IPTables::Log class.
#-----------------------------------------------------------------------
#:Synopsis
#
# use IPTables::Log;
# my $l = IPTables::Log->new;
# my $s = $l->create_set;
# my $r = $s->create_record({text => '...IN=eth0 OUT=eth1 MAC=00:...'});
# $r->parse;
# $s->add($r);
#=======================================================================

# The pod (Perl Documentation) for this module is provided inline. For a
# better-formatted version, please run:-
# $ perldoc Log.pm

=head1 NAME

IPTables::Log - Parse iptables/netfilter syslog messages.

=head1 SYNOPSIS

  use IPTables::Log;
  my $l = IPTables::Log->new;
  my $s = $l->create_set;
  my $r = $s->create_record({text => '...IN=eth0 OUT=eth1 MAC=00:...'});
  $r->parse;
  $s->add($r);

=head1 DEPENDENCIES

=over 4

=item * Carp - for error generation

=item * Class::Accessor - for accessor methods

=item * Data::GUID - for GUID generation

=item * NetAddr::IP - for the C and C methods

=back

=cut

# Set our package name
package IPTables::Log;

# Set minimum version of Perl
use 5.010000;
# Use strict and warnings
use strict;
use warnings;

# Use Carp for errors
use Carp;
# Use IPTables::Log::Set
use IPTables::Log::Set;

# Inherit from Class::Accessor to simplify accessor methods.
use base qw(Class::Accessor);
__PACKAGE__->follow_best_practice;
__PACKAGE__->mk_accessors( qw(raw debug) );

# Set version information
our $VERSION;
$VERSION = "0.0005";

# Hashes of colour
my $clr = "";
my $bold = "";
my $fclr = {'red' => '',
			'green' => '',
			'yellow' => '',
			'blue' => '',
			'purple' => '',
			'cyan' => ''};

my $bclr = {'red' => '',
			'green' => '',
			'yellow' => '',
			'blue' => '',
			'purple' => '',
			'cyan' => ''};

# Generates a debug message if $self->debug == 1
sub debug
{
	my ($self, $msg) = @_;

	if($self->get_debug)
	{
		print $bclr->{blue}.$fclr->{yellow}."D".$clr." ".$fclr->{green}.__PACKAGE__.$clr." ".$fclr->{purple}.$VERSION.$clr." | ".$msg."\n";
	}
}

# As above, but doesn't append a newline
sub debug_nolf
{
	my ($self, $msg) = @_;

	if($self->get_debug)
	{
		print $bclr->{blue}.$fclr->{yellow}."D".$clr." ".$msg;
	}
}

# As per $self->debug, but prints additional information in a chosen colour
sub debug_value
{
	my ($self, $text, $colour, $value) = @_;

	$self->debug($text." ".$self->fcolour($colour, $value));
}

# Prints an error to STDERR
sub error
{
	my ($self, $msg) = @_;

	print STDERR $fclr->{red}."E".$clr." ".$msg."\n";
}

# Prints and error to STDERR, then 'croak's
sub fatal
{
	my ($self, $msg) = @_;

	croak $bclr->{red}.$bold."!".$clr." ".$msg."\n";
}

# Wrap given message in ANSI colour codes
sub fcolour
{
	my ($self, $colour, $text) = @_;

	return $fclr->{$colour}.$text.$clr;
}

=head1 CONSTRUCTORS

=head2 Log->new

Creates a new C object.

=head1 METHODS

=head2 $log->create_set(I 0|1>)

Creates a new C object.

Setting I to B<1> makes L assume that the timestamp and hostname at the beginning of the message is missing (for example, if it's already been processed by another utility).

See L and L for further details.

=cut

sub create_set
{
	my ($self, $args) = @_;

	$args->{'log'} = $self;

	my $set = IPTables::Log::Set->create($args);

	return $set;
}

=head1 CAVEATS

It parses log entries. It doesn't do much else, yet.

=head1 BUGS

None that I'm aware of ;-)

=head1 AUTHOR

This module was written by B .

=head1 COPYRIGHT

$Id: Log.pm 21 2010-12-17 21:07:37Z andys $

(c)2009 Andy Smith (L)

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

=cut

1