App-Iptables2Dot

 view release on metacpan or  search on metacpan

lib/App/Iptables2Dot.pm  view on Meta::CPAN

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(<tr><td PORT="R$rn">$rule</td></tr>);
                $rn++;
            }
        }
        my $lbl = "<table border=\"0\" cellborder=\"1\" cellspacing=\"0\">"
                . qq(<tr><td bgcolor="lightgrey" PORT="name">$node</td></tr>\n)
                . join("\n", @rules, "</table>");
        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)$/) {



( run in 1.054 second using v1.01-cache-2.11-cpan-8f98c5d2c55 )