File Coverage

blib/lib/Parse/Snort/Strict.pm

Criterion	Covered	Total	%
statement	29	29	100.0
branch	2	2	100.0
condition			n/a
subroutine	12	12	100.0
pod	3	3	100.0
total	46	46	100.0

package Parse::Snort::Strict;
use base qw(Parse::Snort);

use strict;
use warnings;
use Carp qw(croak);
use List::Util qw(any);
use Sub::Util qw(set_subname);

our $VERSION = '0.9';

# valid values for rule parts
my $rule_parts_validation = {
  action => [qw( alert pass drop sdrop log activate dynamic reject )],
  proto => [qw( tcp udp ip icmp )],
  direction => [qw( -> <> <- )],
};

# method generator for simple rule parts, copypasta reduction
{
  my $generator = sub {
    # closures are teh awesome.
    my ($part,$value_ref) = @_;
    my $method = "SUPER::$part";

    return sub {
      my ($self,$value) = @_;

      # do validation
      croak "Invalid rule $part: '$value'" unless (any { $value eq $_ } @{ $value_ref });

      # call parent's method for value setting
      $self->$method($value);
    };
  };

  no strict qw(refs);
  while (my ($part,$value_ref) = each %$rule_parts_validation) {
    *{$part} = set_subname($part,$generator->($part,$value_ref));
  }
  use strict qw(refs);
}

# TODO: validate formatting of src/dst address and port, make sure they look like $VARIABLEs or [a:range]

1;

__END__;