#!/usr/bin/perl
use strict;
use YAML;
use IPC::Open3;

use IPTables::Mangle;

=head1 NAME

ipmangle

=head1 SYNOPSIS

   usage: ipmangle --config=[file] [ test | commit | dump | out=[file] ]

   --config   | takes a YAML file
   --dump     | prints processed iptable rules to stdout
   --commit   | commits rules
   --test     | tests rules
   out=[file] | dumps iptables rules to file

=head1 EXAMPLE FILE

Example YAML file, for ease of viewing:

   filter:
       forward: { default: drop }
       foo:
           rules:
              - src: 9.9.9.9
              - src: 10.10.10.10
                action: drop
       input:
           # by default, do not allow any connections unless authorized
           # in the rules below
           default: drop

           # by default, if no "action" is given to a rule below, accept it
           default_rule_action: accept 

           rules:
               # Accept all traffic on loopback interface
               - in-interface: lo

               # Don't disconnect existing connections during a rule change.
               - { match: state, state: 'ESTABLISHED,RELATED' }

               # Allow for pings (no more than 10 a second)
               - { protocol: icmp, icmp-type: 8, match: limit, limit: 10/sec }

               # Allow these IPs, no matter what
               - src: 123.123.123.123

               # example of blocking an IP 
               - { action: drop, src: 8.8.8.8 }

               # example of allowing ip to connect to port 25 (smtp) (one-line)
               - { protocol: tcp, dport: 25, src: 4.2.2.2 }

               # jump to rules defined in "foo" above
               - action: foo

               # if there are no more rules, reject the connection with icmp, don't just let it hang
               - action: reject
                 action_options:
                     reject-with: icmp-admin-prohibited

=head2 TABLES

The top hashref is the table for iptables, this can be either mangle, nat, or filter. 

=head2 CHAINS

The hashref under the top hashref is the chain name.  For system chains the default chainrule can
be set by setting a default hashref in the chain.

$VAR1->{filter}{input} would be the input chain for the filter table.

=head2 CHAIN RULES

Chainrules live in a 'rules' arrayref under the chain, $VAR1->{filter}{input}{rules}, for example.

Every rule in the chain is a hashref which builds a rule.  By default, the jump in the rules, referenced
as 'action' in a rule, is set to accept.  The default action can be modified by changing 
'default_rule_action' in the chain.  Every key in the rule's hashref represents a parameter prefixed by two dashes, '--', 
in an iptables rule.  Two things to note here are that 'action' in a rule really maps to 'jump' in iptables, and 
a special action_options key exists, which references a hashref, which appends options after the iptables jump.  This is 
useful for things like setting '--reject-with' after a jump to reject.


Examples of a chain rule:


# by default, allow this ip

$VAR1->{filter}{input}{rules}[0] = { src => '10.10.10.10' } ;


# allow this ip on port 25 tcp, using accept default

$VAR1->{filter}{input}{rules}[1] = { protocol: 'tcp', dport: 25, src => '10.10.10.10' } ;


# make it explicit

$VAR1->{filter}{input}{rules}[2] = { protocol: 'tcp', dport: 25, src => '10.10.10.10', action => 'accept' } ;


# blacklist an ip

$VAR1->{filter}{input}{rules}[3] = { src => '10.10.10.10', action => 'drop' } ;

# reject with icmp  message

$VAR1->{filter}{input}{rules}[-1] = {
    action => 'reject', 
    action_options => {
        reject-with: 'icmp-admin-prohibited',
    },
};

=cut

my $iptables_restore = '/sbin/iptables-restore';

sub main
{
    # grab options
    my $options = _parse_options();

    my $file = $options->{config};
    return &usage() unless $file;

    die "$0: $file does not exist\n" unless -e $file;

    my $config = Load(_get_file_contents($file));
    my $iptables_rules = IPTables::Mangle::process_config($config);

    if ($options->{test})
    {
        my($wtr, $rdr, $err);
        my $pid = open3($wtr, $rdr, $err, $iptables_restore, '--test');
        print $wtr $iptables_rules;
        close($wtr);
        waitpid( $pid, 0 );

        my $error = '';
        $error .= $_ while (<$rdr>);

        my $child_exit_status = $? >> 8;

        if ($child_exit_status)
        {
            warn "$0: iptables file failed\n======\n$error\n";
            exit(1);
        }
        else
        {
            warn "$0: File parsed successfully\n";
            exit(0);
        }
    }
    elsif ($options->{commit})
    {
        my($wtr, $rdr, $err);
        my $pid = open3($wtr, $rdr, $err, $iptables_restore, '--verbose');
        print $wtr $iptables_rules;
        close($wtr);
        waitpid( $pid, 0 );

        my $child_exit_status = $? >> 8;

        my $error = '';
        $error .= $_ while (<$rdr>);

        my $host = &_local_host();

        if ($child_exit_status)
        {
            warn "[$host $0]: iptables file failed\n======\n$error\n";
            exit(1);
        }
        else
        {
            warn "[$host $0]: Successfully committed rules\n";
            exit(0);
        }
    }
    elsif ($options->{dump})
    {
        print $iptables_rules;
    }
    elsif ($options->{out})
    {
        open(my $tmp_f, "> $options->{out}");
        print $tmp_f $iptables_rules;
        close($tmp_f);
    }
    else
    {
        usage();
    }
}

sub _local_host
{
    open(my $fh, "/etc/hostname");
    my $hostname = <$fh>;
    close($fh);

    $hostname =~ s/\..*$//g;
    $hostname =~ s/[\n\r]//g;

    return $hostname;
}

sub _get_file_contents
{
    my $file = shift;

    open(my $fh, $file);
    my @content = <$fh>;
    close($fh);

    return join('', @content);
}

# quick and dirty
sub _parse_options
{
    my %options;

    my @acceptable_options = qw(
        config commit test dump out
    );

    for my $arg (@ARGV)
    {
        # cleanse all parameters of all unrighteousness
        #   `--` & `-` any parameter shall be removed
        $arg =~ s/^--//;
        $arg =~ s/^-//;

        # does this carry an assignment?
        if ($arg =~ /=/)
        {
            my ($key, $value) = split('=', $arg);

            $options{$key} = $value;
        }
        else
        {
            $options{$arg} = 1;
        }
    }

    for my $option (keys %options)
    {
        die("[$0] `$option` is an invalid option")
            unless (grep { $_ eq $option } @acceptable_options)
    }

    return \%options;
}

sub usage
{
    warn "usage: $0 --config=[file] [ test | commit | dump | out=[file] ]\n";
}

exit __PACKAGE__->main;


=head1 COPYRIGHT

Copyright 2011, 2012 Ohio-Pennsylvania Software, LLC.

=head1 LICENSE

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

=cut
