File Coverage

blib/lib/IPTables/ChainMgr.pm

Criterion	Covered	Total	%
statement	23	319	7.2
branch	0	162	0.0
condition	0	177	0.0
subroutine	8	25	32.0
pod	12	17	70.5
total	43	700	6.1

#
##############################################################################
#
# File: IPTables::ChainMgr.pm
#
# Purpose: Perl interface to add and delete rules to an iptables chain.  The
#          most common application of this module is to create a custom chain
#          and then add blocking rules to it.  Rule additions are (mostly)
#          guaranteed to be unique.
#
# Author: Michael Rash ([e-mail])
#
# Version: 1.6
#
##############################################################################
#

package IPTables::ChainMgr;

use 5.006;
use POSIX ':sys_wait_h';
use Carp;
use IPTables::Parse;
use NetAddr::IP;
use strict;
use warnings;
use vars qw($VERSION);

$VERSION = '1.6';

sub new() {
    my $class = shift;
    my %args  = @_;

    my $self = {};

    $self->{'parse_obj'} = IPTables::Parse->new(%args);

    for my $key ('_cmd',
            '_ipt_bin_name',
            '_iptables',
            '_firewall_cmd',
            '_fwd_args',
            '_ipv6',
            '_iptout',
            '_ipterr',
            '_ipt_alarm',
            '_debug',
            '_verbose',
            '_ipt_exec_style',
            '_ipt_exec_sleep',
            '_sigchld_handler',
            ) {
        $self->{$key} = $self->{'parse_obj'}->{$key};
    }

    bless $self, $class;
}

sub chain_exists() {
    my $self = shift;
    my $table = shift || croak '[*] Must specify a table, e.g. "filter".';
    my $chain = shift || croak '[*] Must specify a chain to check.';

    ### see if the chain exists
    return $self->run_ipt_cmd("$self->{'_cmd'} -t $table -v -n -L $chain");
}

sub create_chain() {
    my $self = shift;
    my $table = shift || croak '[*] Must specify a table, e.g. "filter".';
    my $chain = shift || croak '[*] Must specify a chain to create.';

    ### see if the chain exists first
    my ($rv, $out_ar, $err_ar) = $self->chain_exists($table, $chain);

    ### the chain already exists
    return 1, $out_ar, $err_ar if $rv;

    ### create the chain
    return $self->run_ipt_cmd("$self->{'_cmd'} -t $table -N $chain");
}

sub flush_chain() {
    my $self = shift;
    my $table = shift || croak '[*] Must specify a table, e.g. "filter".';
    my $chain = shift || croak '[*] Must specify a chain.';

    ### flush the chain
    return $self->run_ipt_cmd("$self->{'_cmd'} -t $table -F $chain");
}

sub delete_chain() {
    my $self = shift;
    my $table = shift || croak '[*] Must specify a table, e.g. "filter".';
    my $jump_from_chain = shift ||
        croak '[*] Must specify a chain from which ',
            'packets were jumped to this chain';
    my $del_chain = shift || croak '[*] Must specify a chain to delete.';

    ### see if the chain exists first
    my ($rv, $out_ar, $err_ar) = $self->chain_exists($table, $del_chain);

    ### return true if the chain doesn't exist (it is not an error condition)
    return 1, $out_ar, $err_ar unless $rv;

    ### flush the chain
    ($rv, $out_ar, $err_ar)
        = $self->flush_chain($table, $del_chain);

    ### could not flush the chain
    return 0, $out_ar, $err_ar unless $rv;

    my $ip_any_net = '0.0.0.0/0';
    $ip_any_net = '::/0' if $self->{'_ipv6'};

    ### find and delete jump rules to this chain (we can't delete
    ### the chain until there are no references to it)
    my ($rulenum, $num_chain_rules)
        = $self->find_ip_rule($ip_any_net, $ip_any_net,
            $table, $jump_from_chain, $del_chain, {});

    if ($rulenum) {
        $self->run_ipt_cmd(
            "$self->{'_cmd'} -t $table -D $jump_from_chain $rulenum");
    }

    ### note that we try to delete the chain now regardless
    ### of whether their were jump rules above (should probably
    ### parse for the "0 references" under the -nL  output).
    return $self->run_ipt_cmd("$self->{'_cmd'} -t $table -X $del_chain");
}

sub set_chain_policy() {
    my $self = shift;
    my $table = shift || croak '[*] Must specify a table, e.g. "filter".';
    my $chain = shift || croak '[*] Must specify a chain.';
    my $target  = shift || croak qq|[-] Must specify | .
        qq|$self->{'_ipt_bin_name'} target, e.g. "DROP"|;

    ### set the chain policy: note that $chain must be a built-in chain
    return $self->run_ipt_cmd("$self->{'_cmd'} -t $table -P $chain $target");
}

sub append_ip_rule() {
    my $self = shift;
    my $src = shift || croak '[-] Must specify a src address/network.';
    my $dst = shift || croak '[-] Must specify a dst address/network.';
    my $table   = shift || croak '[-] Must specify a table, e.g. "filter".';
    my $chain   = shift || croak '[-] Must specify a chain.';
    my $target  = shift || croak qq|[-] Must specify | .
        qq|$self->{'_ipt_bin_name'} target, e.g. "DROP"|;

    ### optionally add port numbers and protocols, etc.
    my $extended_hr = shift || {};

    ### -1 for append
    return $self->add_ip_rule($src, $dst, -1, $table,
        $chain, $target, $extended_hr);
}

sub add_ip_rule() {
    my $self = shift;
    my $src = shift || croak '[-] Must specify a src address/network.';
    my $dst = shift || croak '[-] Must specify a dst address/network.';
    (my $rulenum = shift) >= -1 || croak '[-] Must specify insert rule number, or -1 for append.';
    my $table   = shift || croak '[-] Must specify a table, e.g. "filter".';
    my $chain   = shift || croak '[-] Must specify a chain.';
    my $target  = shift ||
        croak qq|[-] Must specify $self->{'_ipt_bin_name'} | .
            qq|target, e.g. "DROP"|;

    ### optionally add port numbers and protocols, etc.
    my $extended_hr = shift || {};

    ### normalize src/dst if necessary; this is because iptables
    ### always reports the network address for subnets
    my $normalized_src = $self->normalize_net($src);
    my $normalized_dst = $self->normalize_net($dst);

    ### first check to see if this rule already exists
    my ($rule_position, $num_chain_rules)
            = $self->find_ip_rule($normalized_src, $normalized_dst, $table,
                $chain, $target, $extended_hr);

    if ($rule_position) {
        my $msg = '';
        if (keys %$extended_hr) {
            $msg = "Table: $table, chain: $chain, $normalized_src -> " .
                "$normalized_dst ";
            for my $key (keys %$extended_hr) {
                $msg .= "$key $extended_hr->{$key} "
                    if defined $extended_hr->{$key};
            }
            $msg .= 'rule already exists.';
        } else {
            $msg = "Table: $table, chain: $chain, $normalized_src -> " .
                "$normalized_dst rule already exists.";
        }
        return 1, [$msg], [];
    }

    ### we need to add the rule
    my $ipt_cmd = '';
    my $msg     = '';
    my $idx_err = '';

    if ($rulenum == 0) {
        $ipt_cmd = "$self->{'_cmd'} -t $table -I $chain 1 ";
    } elsif ($rulenum < 0) {
        ### switch to append mode
        $ipt_cmd = "$self->{'_cmd'} -t $table -A $chain ";
    } else {
        ### check to see if the insertion index ($rulenum) is too big
        if ($rulenum > $num_chain_rules+1) {
            $idx_err = "Rule position $rulenum is past end of $chain " .
                "chain ($num_chain_rules rules), compensating."
                if $num_chain_rules > 0;
            $rulenum = $num_chain_rules + 1;
        }
        $ipt_cmd = "$self->{'_cmd'} -t $table -I $chain $rulenum ";
    }

    if (keys %$extended_hr) {

        my ($ipt_tmp_str, $msg_tmp_str) = $self->build_ipt_matches(
            $extended_hr, $normalized_src, $normalized_dst);

        $msg = "Table: $table, chain: $chain, added $normalized_src " .
            "-> $normalized_dst ";

        ### always add the target at the end
        $ipt_cmd .= "$ipt_tmp_str -j $target";

        $msg .= $msg_tmp_str;
        $msg =~ s/\s*$//;

    } else {
        $ipt_cmd .= "-s $normalized_src -d $normalized_dst -j $target";
        $msg = "Table: $table, chain: $chain, added $normalized_src " .
            "-> $normalized_dst";
    }
    my ($rv, $out_ar, $err_ar) = $self->run_ipt_cmd($ipt_cmd);
    if ($rv) {
        push @$out_ar, $msg if $msg;
    }
    push @$err_ar, $idx_err if $idx_err;
    return $rv, $out_ar, $err_ar;
}

sub build_ipt_matches() {
    my $self = shift;
    my $extended_hr = shift;
    my $normalized_src = shift || '';
    my $normalized_dst = shift || '';

    my $ipt_matches = '';
    my $msg = '';

    if ($IPTables::Parse::VERSION gt 1.1) {

        ### src and dst
        if ($normalized_src ne '') {
            $ipt_matches .= $self->{'parse_obj'}->
                {'parse_keys'}->{'regular'}->{'src'}->{'ipt_match'} .
                " $normalized_src ";
        }

        if ($normalized_src ne '') {
            $ipt_matches .= $self->{'parse_obj'}->
                {'parse_keys'}->{'regular'}->{'dst'}->{'ipt_match'} .
                " $normalized_dst ";
        }

        ### handle 'regular' keys first
        for my $key (keys %$extended_hr) {
            if (defined $self->{'parse_obj'}->{'parse_keys'}->{'regular'}->{$key}) {
                $ipt_matches .= $self->{'parse_obj'}->
                    {'parse_keys'}->{'regular'}->{$key}->{'ipt_match'} .
                    " $extended_hr->{$key} ";
            }
        }

        ### special case for port values (handle them now)
        for my $key (qw/sport s_dport dport d_port/) {
            next unless defined $extended_hr->{$key};
            if ($extended_hr->{$key}) {
                $ipt_matches .= $self->{'parse_obj'}->
                    {'parse_keys'}->{'extended'}->{$key}->{'ipt_match'} .
                    qq| $extended_hr->{$key} |;
            }
        }

        ### now handle 'match' keys
        for my $key (keys %$extended_hr) {
            my $parse_hr = $self->{'parse_obj'}->{'parse_keys'}->{'extended'};
            if (defined $parse_hr->{$key}) {
                next if $key =~ /s_?port$/ or $key =~ /d_?port$/;
                if (defined $parse_hr->{$key}->{'use_quotes'}
                        and $parse_hr->{$key}->{'use_quotes'}) {
                    $ipt_matches .= "$parse_hr->{$key}->{'ipt_match'} " .
                        qq|"$extended_hr->{$key}" |;
                } else {
                    $ipt_matches .= "$parse_hr->{$key}->{'ipt_match'} " .
                        "$extended_hr->{$key} ";
                }
            }
        }

    } else {
        $ipt_matches .= "-p $extended_hr->{'protocol'} "
            if defined $extended_hr->{'protocol'};
        $ipt_matches .= "-s $normalized_src ";
        $ipt_matches .= "--sport $extended_hr->{'s_port'} "
            if defined $extended_hr->{'s_port'};
        $ipt_matches .= "-d $normalized_dst ";
        $ipt_matches .= "--dport $extended_hr->{'d_port'} "
            if defined $extended_hr->{'d_port'};
        $ipt_matches .= "-m mac --mac-source $extended_hr->{'mac_source'} "
            if defined $extended_hr->{'mac_source'};
        $ipt_matches .= "-m state --state $extended_hr->{'state'} "
            if defined $extended_hr->{'state'};
        $ipt_matches .= "-m conntrack --ctstate $extended_hr->{'ctstate'} "
            if defined $extended_hr->{'ctstate'};

        for my $key (keys %$extended_hr) {
            $msg .= "$key $extended_hr->{$key} "
                if defined $extended_hr->{$key};
        }

        ### for NAT
        if (defined $extended_hr->{'to_ip'} and
                defined $extended_hr->{'to_port'}) {
            $ipt_matches .= " --to $extended_hr->{'to_ip'}:" .
                "$extended_hr->{'to_port'}";
            $msg .= "$extended_hr->{'to_ip'}:$extended_hr->{'to_port'}";
        }
    }

    $ipt_matches =~ s/\s*$//;

    return ($ipt_matches, $msg);
}

sub delete_ip_rule() {
    my $self = shift;
    my $src = shift || croak '[-] Must specify a src address/network.';
    my $dst = shift || croak '[-] Must specify a dst address/network.';
    my $table  = shift || croak '[-] Must specify a table, e.g. "filter".';
    my $chain  = shift || croak '[-] Must specify a chain.';
    my $target = shift || croak qq|[-] Must specify | .
        qq|$self->{'_ipt_bin_name'} target, e.g. "DROP"|;
    ### optionally add port numbers and protocols, etc.
    my $extended_hr = shift || {};

    ### normalize src/dst if necessary; this is because iptables
    ### always reports network address for subnets
    my $normalized_src = $self->normalize_net($src);
    my $normalized_dst = $self->normalize_net($dst);

    ### first check to see if this rule already exists
    my ($rulenum, $num_chain_rules)
        = $self->find_ip_rule($normalized_src,
            $normalized_dst, $table, $chain, $target, $extended_hr);

    if ($rulenum) {
        ### we need to delete the rule
        return $self->run_ipt_cmd("$self->{'_cmd'} -t $table -D $chain $rulenum");
    }

    my $extended_msg = '';
    if (keys %$extended_hr) {
        for my $key (keys %$extended_hr) {
            $extended_msg .= "$key: $extended_hr->{$key} "
                if defined $extended_hr->{$key};
        }
        ### for NAT
        if (defined $extended_hr->{'to_ip'} and
                defined $extended_hr->{'to_port'}) {
            $extended_msg .= "$extended_hr->{'to_ip'}:" .
                "$extended_hr->{'to_port'}";
        }
    }
    $extended_msg =~ s/\s*$//;
    return 0, [], ["Table: $table, chain: $chain, rule $normalized_src " .
        "-> $normalized_dst $extended_msg does not exist."];
}

sub find_ip_rule() {
    my $self = shift;
    my $debug   = $self->{'_debug'};
    my $verbose = $self->{'_verbose'};
    my $src   = shift || croak '[*] Must specify source address.';
    my $dst   = shift || croak '[*] Must specify destination address.';
    my $table = shift || croak qq|[*] Must specify $self->{'_ipt_bin_name'} table.|;
    my $chain = shift || croak qq|[*] Must specify $self->{'_ipt_bin_name'} chain.|;
    my $target = shift || croak qq|[*] Must specify | .
        qq|$self->{'_ipt_bin_name'} target (this may be a chain).|;

    ### optionally add port numbers and protocols, etc.
    my $extended_hr = shift || {};

    my $fh = *STDERR;
    $fh = *STDOUT if $verbose;

    if ($debug or $verbose) {
        print $fh localtime() . " [+] IPTables::Parse::VERSION ",
            "$IPTables::Parse::VERSION\n"
    }

    ### default if IPTables::Parse version < 1.2
    my @parse_keys = (qw(protocol s_port d_port to_ip
            to_port mac_source state ctstate));

    if ($IPTables::Parse::VERSION gt '1.1') {

        @parse_keys = ();

        ### get the keys list from the IPTables::Parse module
        for my $key (keys %{$self->{'parse_obj'}->{'parse_keys'}->{'regular'}}) {
            push @parse_keys, $key;
        }
        for my $key (keys %{$self->{'parse_obj'}->{'parse_keys'}->{'extended'}}) {
            push @parse_keys, $key;
        }

        ### make sure that an unsupported search criteria is not required
        if (keys %$extended_hr) {
            for my $key (keys %$extended_hr) {
                next if $key eq 'normalize';
                my $found = 0;
                for my $supported_key (@parse_keys) {
                    if ($key eq $supported_key) {
                        $found = 1;
                        last;
                    }
                }
                unless ($found) {
                    croak "[*] Extended hash search key '$key' not " .
                        "supported by IPTables::Parse";
                }
            }
        }
    }

    my $chain_ar = $self->{'parse_obj'}->chain_rules($table, $chain);

    $src = $self->normalize_net($src) if defined $extended_hr->{'normalize'}
        and $extended_hr->{'normalize'};
    $dst = $self->normalize_net($dst) if defined $extended_hr->{'normalize'}
        and $extended_hr->{'normalize'};

    my $rulenum = 1;
    for my $rule_hr (@$chain_ar) {
        if ($rule_hr->{'target'} eq $target
                and $rule_hr->{'src'} eq $src
                and $rule_hr->{'dst'} eq $dst) {
            if (keys %$extended_hr) {
                my $found = 1;
                for my $key (@parse_keys) {
                    if (defined $extended_hr->{$key}) {
                        if (defined $rule_hr->{$key}) {
                            if ($key eq 'state' or $key eq 'ctstate') {
                                ### make sure that state ordering as reported
                                ### by iptables is accounted for vs. what was
                                ### supplied to the module
                                unless (&state_compare($extended_hr->{$key},
                                        $rule_hr->{$key})) {
                                    $found = 0;
                                    last;
                                }
                            } elsif ($key eq 'mac_source') {
                                ### make sure case does not matter
                                unless (lc($extended_hr->{$key})
                                        eq lc($rule_hr->{$key})) {
                                    $found = 0;
                                    last;
                                }
                            } else {
                                unless ($extended_hr->{$key}
                                        eq $rule_hr->{$key}) {
                                    $found = 0;
                                    last;
                                }
                            }
                        } else {
                            $found = 0;
                            last;
                        }
                    }
                }
                return $rulenum, $#$chain_ar+1 if $found;
            } else {
                if ($rule_hr->{'protocol'} eq 'all') {
                    if ($target eq 'LOG' or $target eq 'ULOG') {
                        ### built-in LOG and ULOG target rules always
                        ### have extended information
                        return $rulenum, $#$chain_ar+1;
                    } elsif (not $rule_hr->{'extended'}) {
                        ### don't want any additional criteria (such as
                        ### port numbers) in the rule. Note that we are
                        ### also not checking interfaces
                        return $rulenum, $#$chain_ar+1;
                    }
                }
            }
        }
        $rulenum++;
    }
    return 0, $#$chain_ar+1;
}

sub print_parse_capabilities() {
    my $self = shift;

    if ($IPTables::Parse::VERSION gt 1.1) {

        print "[+] IPTables::Parse regular options:\n";
        for my $key (keys %{$self->{'parse_obj'}->{'parse_keys'}->{'regular'}}) {
            my $p_hr = $self->{'parse_obj'}->{'parse_keys'}->{'regular'}->{$key};
            print "    $key\n";
            if (defined $p_hr->{'regex'} and $p_hr->{'regex'}) {
                print "      regex: $p_hr->{'regex'}", "\n";
            }
            if (defined $p_hr->{'ipt_match'} and $p_hr->{'ipt_match'}) {
                print "      ipt_match: $p_hr->{'ipt_match'} ", "\n";
            }
        }

        print "\n[+] IPTables::Parse extended options:\n";
        for my $key (keys %{$self->{'parse_obj'}->{'parse_keys'}->{'extended'}}) {
            my $p_hr = $self->{'parse_obj'}->{'parse_keys'}->{'extended'}->{$key};
            print "    $key\n";
            if (defined $p_hr->{'regex'} and $p_hr->{'regex'}) {
                print "      regex: $p_hr->{'regex'}", "\n";
            }
            if (defined $p_hr->{'ipt_match'} and $p_hr->{'ipt_match'}) {
                print "      ipt_match: $p_hr->{'ipt_match'} ", "\n";
            }
        }

    } else {
        print "[+] IPTables::Parse capabilities:\n";
        for my $key (qw(protocol s_port d_port to_ip
                to_port mac_source state ctstate)) {
            print "    $key\n";
        }
    }
    return;
}

sub state_compare() {
    my ($state_str1, $state_str2) = @_;

    my @states1 = split /,/, $state_str1;
    my @states2 = split /,/, $state_str2;

    for my $state1 (@states1) {
        my $found = 0;
        for my $state2 (@states2) {
            if ($state1 eq $state2) {
                $found = 1;
                last;
            }
        }
        return 0 unless $found;
    }

    for my $state2 (@states2) {
        my $found = 0;
        for my $state1 (@states1) {
            if ($state2 eq $state1) {
                $found = 1;
                last;
            }
        }
        return 0 unless $found;
    }

    return 1;
}

sub normalize_net() {
    my $self = shift;
    my $net  = shift || croak '[*] Must specify net.';

    my $normalized_net = $net;  ### establish default

    ### regex to match an IPv4 address
    my $ipv4_re = qr/(?:\d{1,3}\.){3}\d{1,3}/;

    if ($net =~ m|/| and $net =~ $ipv4_re or $net =~ m|:|) {
        if ($net =~ m|:|) {  ### an IPv6 address
            my $n = NetAddr::IP->new6($net)
                or croak "[*] Could not acquire NetAddr::IP object for $net";
            $normalized_net = lc($n->network()->short()) . '/' . $n->masklen();
            $normalized_net =~ s|/128$||;
        } else {
            my $n = NetAddr::IP->new($net)
                or croak "[*] Could not acquire NetAddr::IP object for $net";
            $normalized_net = $n->network()->cidr();
            $normalized_net =~ s|/32$||;
        }
    }
    return $normalized_net;
}

sub add_jump_rule() {
    my $self  = shift;
    my $table = shift || croak '[-] Must specify a table, e.g. "filter".';
    my $from_chain = shift || croak '[-] Must specify chain to jump from.';
    my $rulenum    = shift || croak '[-] Must specify jump rule chain position';
    my $to_chain   = shift || croak '[-] Must specify chain to jump to.';
    my $idx_err = '';

    if ($from_chain eq $to_chain) {
        return 0, ["Identical from_chain and to_chain ($from_chain) " .
            "not allowed."], [];
    }

    my $ip_any_net = '0.0.0.0/0';
    $ip_any_net = '::/0' if $self->{'_ipv6'};

    ### first check to see if the jump rule already exists
    my ($rule_position, $num_chain_rules)
        = $self->find_ip_rule($ip_any_net, $ip_any_net, $table,
            $from_chain, $to_chain, {});

    ### check to see if the insertion index ($rulenum) is too big
    $rulenum = 1 if $rulenum <= 0;
    if ($rulenum > $num_chain_rules+1) {
        $idx_err = "Rule position $rulenum is past end of $from_chain " .
            "chain ($num_chain_rules rules), compensating."
            if $num_chain_rules > 0;
        $rulenum = $num_chain_rules + 1;
    }
    $rulenum = 1 if $rulenum == 0;

    if ($rule_position) {
        ### the rule already exists
        return 1,
            ["Table: $table, chain: $to_chain, jump rule already exists."], [];
    }

    ### we need to add the rule
    my ($rv, $out_ar, $err_ar) = $self->run_ipt_cmd(
        "$self->{'_cmd'} -t $table -I $from_chain $rulenum -j $to_chain");
    push @$err_ar, $idx_err if $idx_err;
    return $rv, $out_ar, $err_ar;
}

sub REAPER {
    my $stiff;
    while(($stiff = waitpid(-1,WNOHANG))>0){
        # do something with $stiff if you want
    }
    local $SIG{'CHLD'} = \&REAPER;
    return;
}

sub run_ipt_cmd() {
    my $self  = shift;
    my $cmd = shift || croak qq|[*] Must specify | .
        qq|$self->{'_ipt_bin_name'} command to run.|;

    ### iptables execution is provided by IPTables::Parse which is
    ### a dependency of IPTables::ChainMgr
    return $self->{'parse_obj'}->exec_iptables($cmd);
}

1;

__END__