File Coverage

IPTables.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

# -*- mode: cperl; cperl-indent-level: 4; -*-
# vi:ai:sm:et:sw=4:ts=4

# $Id: IPTables.pm,v 1.9 2005/11/18 23:40:00 paulv Exp $

package POE::Filter::Log::IPTables;

use strict;
use warnings;
use POE::Filter::Line;
use Carp qw(carp croak);

our $VERSION = '0.02';

sub new {
    my $class = shift;

    croak "$class requires an even number of parameters" if @_ and @_ & 1;

    my %params = @_;

    my $self = {};

    $self->{line} = POE::Filter::Line->new();

    # the types of ICMP messages that require us to do further
    # processing
    $self->{icmp_types} = ['3',  # destination unreachable
                           '4',  # source quench
                           '11', # time exceeded
                          ];

    if (defined $params{Debug} and $params{Debug} > 0) {
        $self->{debug} = 1;
    } else {
        $self->{debug} = 0;
    }

    if (defined $params{Syslog} and $params{Syslog} > 0) {
        $self->{syslog} = 1;
    } else {
        $self->{syslog} = 0;
    }

    bless ($self, $class);
    return $self;
}

sub get {
    my $self = shift;
    my $chunk = shift;
    my @queue;

    my $lines = $self->{line}->get($chunk);
    foreach my $line (@$lines) {
        push(@queue, $self->_parse($line));
    }
    return \@queue;
}

sub _parse {
    my $self = shift;
    my $line = shift;

    my $ds;
    my $leftover;

    # save the whole line so the user can twiddle it if she wants.
    $ds->{line} = $line;

    # strip off syslog stuff
    if ($self->{syslog}) {
        # Jan 11 17:30:35 hostname kernel:
        $line =~ s/^\w\w\w\s+\d+ \d\d:\d\d:\d\d (?:\w|-|\.|_)+ //;
    }

    # remove prefix
    $line =~ s/kernel: (.{0,29}) ?IN/IN/;

    # IN, OUT, and MAC
    print "base: [$line]\n" if $self->{debug};

    # inbound interface
    if ($line =~ /^IN=(\w+)? /) {
        $ds->{in_int} = $1;

        if ($1) {
            $line =~ s/IN=$1 //;
        } else {
            $line =~ s/IN= //;
        }
    }

    # outbound interface
    if ($line =~ / ?OUT=([A-Za-z0-9]+)? /) {
        $ds->{out_int} = $1;

        if ($1) {
            $line =~ s/ ?OUT=$1 //;
        } else {
            $line =~ s/ ?OUT= //;
        }
    }

    # input MAC address
    if ($line =~ / ?MAC=([0-9A-F:]+)? /i) {
        $ds->{mac} = $1;

        if ($1) {
            $line =~ s/ ?MAC=$1 //;
        } else {
            $line =~ s/ ?MAC= //;
        }
    }

    print "BASE done: [$line]\n" if $self->{debug};

    # the IP header
    ($line, $ds->{ip}) = $self->_parseIP($line);

    # everything else

    # ICMP has to be done first because ICMP messages sometimes have IP
    # headers in them.
    if ($line =~/ ?PROTO=ICMP /) {
        $line =~ s/^PROTO=ICMP //g;
        $ds->{ip}->{type} = "icmp";
        ($ds->{ip}->{icmp}, $leftover) = $self->_parseICMP($line);
    } elsif ($line =~ / ?PROTO=TCP /) {
        $line =~ s/^PROTO=TCP //g;
        $ds->{ip}->{type} = "tcp";
        ($ds->{ip}->{tcp}, $leftover) = $self->_parseTCP($line);
    } elsif ($line =~/ ?PROTO=UDP /) {
        $line =~ s/^PROTO=UDP //g;
        $ds->{ip}->{type} = "udp";
        ($ds->{ip}->{udp}, $leftover) = $self->_parseUDP($line);
    } else {
#        $line =~ s/^PROTO=//g;
        ($ds->{ip}->{type}, $leftover) = $self->_parseUnknown($line);
    }

    $ds->{leftover} = $leftover;

    return $ds;
}

sub _parseIP {
    my $self = shift;
    my $line = shift;
    my $ds;

    print "IP: [$line]\n" if $self->{debug};

    # source address
    if ($line =~ / ?SRC=(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}) /) {
        $ds->{src_addr} = $1;
        $line =~ s/ ?SRC=$1 //;
    }

    # destination address
    if ($line =~ / ?DST=(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}) /) {
        $ds->{dst_addr} = $1;
        $line =~ s/ ?DST=$1 //;
    }

    # length
    if ($line =~ / ?LEN=(\d+) /) {
        $ds->{len} = $1;
        $line =~ s/ ?LEN=$1 //;
    }

    # type of service
    if ($line =~ / ?TOS=(0x[0-9A-Z]{2}) /i) {
        $ds->{tos} = $1;
        $line =~ s/ ?TOS=$1 //;
    }

    # PREC?
    if ($line =~ / ?PREC=(0x[0-9A-Z]{2}) /i) {
        $ds->{prec} = $1;
        $line =~ s/ ?PREC=$1 //;
    }

    # time to live
    if ($line =~ / ?TTL=(\d+) /) {
        $ds->{ttl} = $1;
        $line =~ s/ ?TTL=$1 //;
    }

    # ip id
    if ($line =~ / ?ID=(\d+) /) {
        $ds->{id} = $1;
        $line =~ s/ ?ID=$1 //;
    }

    # congestion
    if ($line =~ /^CE /) {
        push(@{$ds->{fragment_flags}}, "CE");
        $line =~ s/^CE //;
    }

    # don't fragment
    if ($line =~ /^DF /) {
        push(@{$ds->{fragment_flags}}, "DF");
        $line =~ s/^DF //;
    }

    # more fragments
    if ($line =~ /^MF /) {
        push(@{$ds->{fragment_flags}}, "MF");
        $line =~ s/^MF //;
    }

    print "IP done: [$line]\n" if $self->{debug};

    return ($line, $ds);
}

sub _parseTCP {
    my $self = shift;
    my $line = shift;
    my $ds;

    print "TCP: [$line]\n" if $self->{debug};

    # SPT=36073 DPT=22 WINDOW=5840 RES=0x00 SYN URGP=0

    # source port
    if ($line =~ /SPT=(\d+) /) {
        $ds->{src_port} = $1;
        $line =~ s/SPT=$1 //;
    }

    # destination port
    if ($line =~ /DPT=(\d+) /) {
        $ds->{dst_port} = $1;
        $line =~ s/DPT=$1 //;
    }

    # window length
    if ($line =~ /WINDOW=(\d+) /) {
        $ds->{window} = $1;
        $line =~ s/WINDOW=$1 //;
    }

    # reserved bits
    if ($line =~ /RES=(0x[0-9A-Z]{2}) /i) {
        $ds->{res} = $1;
        $line =~ s/RES=$1 //;
    }

    # flags
    #
    # CWR ECE URG ACK PSH RST SYN FIN
    # CWR - Congestion Window Reduced
    # ECE - Explicit Congestion Notification echo
    # URG - Urgent
    # ACK - Acknowledgement
    # PSH - Push
    # RST - Reset
    # SYN - Synchronize
    # FIN - Finished

    if ($line =~ /CWR /) {
        push(@{$ds->{flags}}, "CWR");
        $line =~ s/CWR //;
    }

    if ($line =~ /ECE /) {
        push(@{$ds->{flags}}, "ECE");
        $line =~ s/ECE //;
    }

    if ($line =~ /URG /) {
        push(@{$ds->{flags}}, "URG");
        $line =~ s/URG //;
    }

    if ($line =~ /ACK /) {
        push(@{$ds->{flags}}, "ACK");
        $line =~ s/ACK //;
    }

    if ($line =~ /PSH /) {
        push(@{$ds->{flags}}, "PSH");
        $line =~ s/PSH //;
    }

    if ($line =~ /RST /) {
        push(@{$ds->{flags}}, "RST");
        $line =~ s/RST //;
    }

    if ($line =~ /SYN /) {
        push(@{$ds->{flags}}, "SYN");
        $line =~ s/SYN //;
    }

    if ($line =~ /FIN /) {
        push(@{$ds->{flags}}, "FIN");
        $line =~ s/FIN //;
    }

    # urgent pointer

    if ($line =~ /URGP=(\d+) ?/) {
        $ds->{urgp} = $1;
        $line =~ s/URGP=$1 ?//;
    }

    print "TCP done: [$line]\n" if $self->{debug};

    if ($line and $line !~ /^\s+$/) {
        return ($ds, $line);
    } else {
        return ($ds, undef);
    }
}

sub _parseUDP {
    my $self = shift;
    my $line = shift;
    my $ds;

    print "UDP: [$line]\n" if $self->{debug};

    # SPT=10890 DPT=33440 LEN=12

    # source port
    if ($line =~ /SPT=(\d+) /) {
        $ds->{src_port} = $1;
        $line =~ s/SPT=$1 //;
    }

    # destination port
    if ($line =~ /DPT=(\d+) /) {
        $ds->{dst_port} = $1;
        $line =~ s/DPT=$1 //;
    }

    # length
    if ($line =~ /LEN=(\d+) ?/) {
        $ds->{len} = $1;
        $line =~ s/LEN=$1 ?//;
    }

    print "UDP done: [$line]\n" if $self->{debug};

    if ($line and $line !~ /^\s+$/) {
        return ($ds, $line);
    } else {
        return ($ds, undef);
    }

}

sub _parseICMP {
    my $self = shift;
    my $line = shift;
    my $ds;

    print "ICMP: [$line]\n" if $self->{debug};

    if ($line =~ /TYPE=(\d+) /) {
        $ds->{type} = $1;
        $line =~ s/TYPE=$1 //;
    }

    if ($line =~ /CODE=(\d+) /) {
        $ds->{code} = $1;
        $line =~ s/CODE=$1 //;
    }

    my $packet;
    foreach my $type (@{$self->{icmp_types}}) {

        if ($type == $ds->{type}) {
            if ($line =~ /\[(.+)\]/) {
                $packet = $1;
                $ds->{error_header} = $self->_parse($packet);
            } else {
                carp("got a ICMP packet with type of $type, but couldn't " .
                     "extract the IP header...");
            }
        }
    }

    # strip out the thing
    if ($packet) {
        my $quoted = quotemeta($packet);
        $line =~ s/\[$quoted\]//;
    }

    if ($line =~ /ID=(\d+) /) {
        $ds->{id} = $1;
        $line =~ s/ID=$1 //;
    }

    if ($line =~ /SEQ=(\d+) ?/) {
        $ds->{seq} = $1;
        $line =~ s/SEQ=$1 ?//;
    }

    print "ICMP done: ($line)\n" if $self->{debug};

    if ($line and $line !~ /^\s+$/) {
        return ($ds, $line);
    } else {
        return ($ds, undef);
    }
}

sub _parseUnknown {
    my $self = shift;
    my $line = shift;
    my $proto;

    if ($line =~ /PROTO=(\w+) ?/) {
        $proto = (getprotobynumber($1))[0];

        if (not defined($proto)) {
            $proto = "unknown";
        }

        $line =~ s/PROTO=$1 ?//;
    }

    if ($line and $line !~ /^\s+$/) {
        return ($proto, $line);
    } else {
        return ($proto, undef);
    }
}


1;
__END__