File Coverage

blib/lib/App/Iptables2Dot.pm

Criterion	Covered	Total	%
statement	145	150	96.6
branch	49	54	90.7
condition	30	43	69.7
subroutine	15	15	100.0
pod	5	5	100.0
total	244	267	91.3

package App::Iptables2Dot;

# vim: set sw=4 ts=4 tw=78 et si filetype=perl:

use warnings;
use strict;
use Carp;
use Getopt::Long qw(GetOptionsFromString);

use version; our $VERSION = qv('v0.3.3');

# Module implementation here

my @optdefs = qw(
    checksum-fill
    clamp-mss-to-pmtu
    comment=s
    ctstate=s
    destination|d=s
    destination-ports|dports=s
    dport=s
    dst-type=s
    gid-owner=s
    goto|g=s
    helper=s
    in-interface|i=s
    icmp-type=s
    jump|j=s
    limit=s
    limit-burst=s
    log-prefix=s
    m=s
    mac-source=s
    match-set=s
    mss=s
    notrack
    o=s
    physdev-in=s
    physdev-is-bridged
    physdev-is-in
    physdev-is-out
    physdev-out=s
    protocol|p=s
    reject-with
    socket-exists
    source|s=s
    sport=s
    state=s
    suppl-groups
    tcp-flags=s
    to-destination=s
    to-ports=s
    to-source
    uid-owner=s
    ulog-prefix=s
);

sub new {
    my ($self) = @_;
    my $type = ref($self) || $self;

    $self = bless { nodemap => {}, nn => 0 }, $type;

    return $self;
} # new()

sub add_optdef {
    my $optdef = shift;
    push @optdefs, $optdef;
} # add_optdef()

# dot_graph($opt, @graphs)
#
# Creates a graph in the 'dot' language for all tables given in the list
# @graphs.
#
# Returns the graph as string.
#
sub dot_graph {
    my $self = shift;
    my $opt  = shift;
    my $subgraphs = '';
    foreach my $graph (@_) {
        $subgraphs .= $self->_dot_subgraph($opt,$graph);
    }
    my $ranks = join "; ", $self->_internal_nodes($opt,@_); # determine all internal chains
    my $graph = <<"EOGRAPH";
digraph iptables {
  { rank = source; $ranks; }
  rankdir = LR;
$subgraphs
}
EOGRAPH
    return $graph;
} # dot_graph()

sub read_iptables {
    my ($self,$input) = @_;

    while (<$input>) {
        $self->_read_iptables_line($_);
    }
} # read_iptables()

sub read_iptables_file {
	my ($self,$fname) = @_;

	if (open(my $input, '<', $fname)) {
		$self->read_iptables($input);
		close $input;
	}
	else {
		die "can't open file '$fname' to read iptables-save output";
	}
} # read_iptables_file()

## internal functions only

# _dot_edges($table)
#
# Lists all jumps between chains in the given table as edge description in the
# 'dot' language.
#
# Returns a list of edge descriptions.
#
sub _dot_edges {
    my ($self,$opt,$table) = @_;
    my @edges = ();
    my %seen  = ();
    my $re_it = qr/^(MASQUERADE|RETURN|TCPMSS)$/;
    foreach my $edge (@{$self->{jumps}->{$table}}) {
        my $tp  = ':w';
        my $lbl = '';
        if ($opt->{edgelabel} && $edge->[2]) {
            $lbl = " [label=\"$edge->[2]\"]";
        }
        unless ($edge->[1] =~ $re_it) {
            $tp = ":name:w";
        }
        my $e0 = $edge->[0];
        my $e1 = $edge->[1];
        if ($opt->{"use-numbered-nodes"}) {
            $e0 = $self->{nodemap}->{$edge->[0]} || $edge->[0];
            $e1 = $self->{nodemap}->{$edge->[1]} || $edge->[1];
        }
        if ($opt->{showrules}) {
            if (my $ot = $opt->{'omittargets'}) {
                my %omit = map { $_ => 1, } split(',',$ot);
                push @edges, "$e0:R$edge->[3]:e -> $e1$tp$lbl;"
                    unless ($omit{$edge->[1]});
            }
            else {
                push @edges, "$e0:R$edge->[3]:e -> $e1$tp$lbl;";
            }
        }
        else {
            my $etext = "$e0:e -> $e1$tp$lbl";
            unless ($seen{$etext} ++) {
                push @edges, $etext;
            }
        }
    }
    if ($opt->{showrules} || $opt->{edgelabel}) {
        return @edges;
    }
    else {
        my @le = map {
            1 < $seen{$_} ? qq($_ [label="($seen{$_})"];) : qq($_;);
        } @edges;
        return @le;
    }
} # _dot_edges()

# _dot_nodes($table)
#
# Lists all chains in the given table as node descriptions in the 'dot'
# language.
#
# Returns a list of node descriptions.
#
sub _dot_nodes {
    my ($self,$opt,$table) = @_;
    my @nodes = ();
    my %used = ();
    unless ($opt->{showunusednodes} || $opt->{"use-numbered-nodes"}) {
        %used = map { $_->[0] => 1, } @{$self->{jumps}->{$table}};
    }
    foreach my $node (keys %{$self->{chains}->{$table}}) {
        next unless ($used{$node}
                    || $opt->{showunusednodes}
                    || $opt->{"use-numbered-nodes"});
        my @rules = ();
        my $rn = 0;
        if ($opt->{showrules}) {
            foreach my $rule (@{$self->{chains}->{$table}->{$node}->{rules}}) {
                push @rules, qq(
                $rn++;
            }
        }
        my $lbl = "" \n) 




201




 





 





 





 





 





 



                 . qq($node




202




 





 





 





 





 





 



                 . join("\n", @rules, "");
                . qq(
                . join("\n", @rules, "
        if ($opt->{"use-numbered-nodes"}) {
            push @nodes, $self->{nodemap}->{$node} ." [shape=none,margin=0,label=<$lbl>];";
        }
        else {
            push @nodes, "$node [shape=none,margin=0,label=<$lbl>];";
        }
    }
    return @nodes;
} # _dot_nodes()

# _dot_subgraph($opt, $table)
#
# Creates a subgraph in the 'dot' language for the table given in $table.
#
# Returns the subgraph as string.
#
sub _dot_subgraph {
    my ($self,$opt,$table) = @_;
    my $nodes  = join "\n    ", $self->_dot_nodes($opt,$table);
    my $edges  = join "\n    ", $self->_dot_edges($opt,$table);
    my $graph  = <<"EOGRAPH";
  subgraph $table {
    $nodes
    $edges
  }
EOGRAPH
    return $graph;
} # _dot_subgraph()

# _internal_nodes(@tables)
#
# Lists all chains from all tables in @tables, that are internal chains.
#
# Returns a list of all internal tables.
#
sub _internal_nodes {
    my $self      = shift;
    my $opt       = shift;
    my $re_in     = qr/^(PREROUTING|POSTROUTING|INPUT|FORWARD|OUTPUT)$/;
    my @nodes     = ();
    my %have_node = ();
    my %used      = ();
    foreach my $table (@_) {
        unless ($opt->{showunusednodes} || $opt->{"use-numbered-nodes"}) {
            %used = map { $_->[0] => 1, } @{$self->{jumps}->{$table}};
        }
        foreach my $node (sort keys %{$self->{chains}->{$table}}) {
            next unless ($used{$node}
                        || $opt->{showunusednodes}
                        || $opt->{"use-numbered-nodes"});
            if (!$have_node{$node} && $node =~ $re_in) {
                if ($opt->{"use-numbered-nodes"}) {
                    push @nodes, $self->{nodemap}->{$node} || qq("$node");
                }
                else {
                    push @nodes, qq("$node");
                }
                $have_node{$node} = 1;
            }
        }
    }
    return @nodes;
} # _internal_nodes()

# _read_iptables_line($line)
#
# Reads the next line from iptables output and creates an entry in the rules
# and or jump table for it.
#
# Returns nothing.
#
sub _read_iptables_line {
    my ($self,$line) = @_;
    return if ($line =~ /^#.*$/);
    return if ($line =~ /^COMMIT$/);
    chomp;
    if ($line =~ /^\*(\S+)$/) {
        $self->{last_table} = $1;
        push @{$self->{tables}}, $1;
        $self->{chains}->{$1} = {};
        $self->{jumps}->{$1}  = [];
    }
    elsif ($line =~ /^:(\S+)\s.+$/) {
        $self->{chains}->{$self->{last_table}}->{$1} = { rules => [] };
        unless ($self->{nodemap}->{$1}) {
                $self->{nodemap}->{$1} = "node" . $self->{nn};
                $self->{nn} += 1;
        }
    }
    elsif ($line =~ /^-A\s(\S+)\s(.+)$/) {
        my $chain = $1;
        my $rule  = $2;
        my %opt;
        my $last_table = $self->{last_table};
        my ($ret, $args) = GetOptionsFromString($rule,\%opt,@optdefs);
        if ($ret) {
            my $iface = $opt{'in-interface'} || '';
            my $target = $opt{'jump'} || $opt{'goto'} || '';
            unless ($target =~ /^(ACCEPT|DROP|REJECT)$/) {
                unless ($self->{nodemap}->{$1}) {
                        $self->{nodemap}->{$1} = "node" . $self->{nn};
                        $self->{nn} += 1;
                }
                my $rn = scalar @{$self->{chains}{$last_table}->{$chain}->{rules}};
                push @{$self->{jumps}->{$last_table}}, [ $chain, $target, $iface, $rn ];
            }
        }
        else {
            die "unknown argument in rule: $rule";
        }
        push @{$self->{chains}->{$last_table}->{$chain}->{rules}}, $rule;
    }
    else {
        die "unrecognized line: $line";
    }
    return;
} # _read_iptables_line()

1; # Magic true value required at end of module
__END__