#!/usr/local/bin/perl
# cut-netspoc
# Print parts of a netspoc configuration to stdout.
# http://netspoc.berlios.de
# (c) 2009 by Heinz Knutzen <heinzknutzen@users.berlios.de>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# $Id: cut-netspoc,v 1.20 2010/11/19 14:12:17 heinz Exp $

use strict;
use warnings;
use FindBin;
use lib $FindBin::Bin;
use Netspoc;
#use open ':locale';
use locale;


####################################################################
# Argument processing
####################################################################
sub usage() {
    die "Usage: $0 {in-file | in-directory} policy:name ...\n";
}

# Enhanced version of read_netspoc, which stores source code of each
# global definition.
sub read_netspoc_with_src () {
    my $pre    = pos $Netspoc::input;
    my $object = &read_netspoc();
    my $post   = pos $Netspoc::input;
    $object->{src_code} = substr $Netspoc::input, $pre, $post - $pre;

#    print STDERR "$object->{name} $pre-$post\n";
    return $object;
}

# This function is called by path_walk to mark all networks and routers
# on path from src to dst of $rule with attribute {is_used}.
sub mark_topology( $$$ ) {
    my ($rule, $in_intf, $out_intf) = @_;
    my $router = ($in_intf || $out_intf)->{router};
    $router->{is_used} = 1;

    # Not only networks on path, but all connected networks need to be marked
    # to get a valid topology.
    for my $interface (@{ $router->{interfaces} }) {
        $interface->{network}->{is_used} = 1;
    }
}

####################################################################
# Main program
####################################################################

my $config = shift @ARGV or usage;
&show_version();

# Read and process netspoc configuration data.
# Remember source code of each global definition.
&read_file_or_dir($config, \&read_netspoc_with_src);

my %name2var = ( policy =>\%policies, );

# Read names of policies from command line.
for my $arg (@ARGV) {
    my ($type, $name) = split_typed_name $arg;
    my $ref = $name2var{$type} or usage;
    my $thing = $ref->{$name} or fatal_err "Unknown $arg";
    $thing->{is_used} = 1;
}

# Delete unwanted global definitions.
for my $ref (values %name2var) {
    for my $name (keys %$ref) {
	unless ($ref->{$name}->{is_used}) {
	    delete $ref->{$name};
	}
    }
}

&order_services();
&link_topology();
&mark_disabled();
&setany();
&setpath();
&expand_policies(1);
die "Aborted with $error_counter error(s)\n" if $error_counter;

# Process rules of policies.
sub process_rules ( $ ) {
    my ($expanded_rules) = @_;
    for my $type ('deny', 'any', 'permit') {
	for my $rule (@{ $expanded_rules->{$type} }) {
	    for my $where ('src', 'dst') {

		# path_walk only handles networks and routes,
		# therefore 'any' objects need to be marked separately.
		is_any $rule->{$where} and $rule->{$where}->{is_used} = 1;
	    }
	    &path_walk($rule, \&mark_topology);
	    if($rule->{orig_srv}){
		$rule->{orig_srv}->{is_used} = 1;
	    } else {
		$rule->{srv}->{is_used} = 1;
	    }
	}
    }
}

# Mark parts of topology which are referenced by rules of policies.
process_rules \%expanded_rules;

# Mark interfaces which are referenced by areas.
for my $area (values %areas) {
    if ($area->{is_used}) {
        if (my $anchor = $area->{anchor}) {
            $anchor->{is_used} = 1;
        }
        else {
            for my $interface (@{ $area->{border} }) {
                mark_topology undef, $interface, undef;
            }
        }
    }
}

# Mark networks which are referenced by 'any' objects.
for my $any (values %anys) {
    if($any->{is_used}) {

	# Router isn't handled currently.
	my $network = $any->{link};
	$network->{is_used} = 1;
    }
}

# Call this after topology has been marked.
&expand_crypto();

for my $router (values %routers) {
    next unless $router->{is_used};
    for my $interface (@{$router->{interfaces}}) {

	# Mark networks referenced in attribute reroute_permit.
	if ($interface->{reroute_permit}) {
	    for my $net (@{ $interface->{reroute_permit} }) {
		my $rule = {src => $interface, dst => $net, srv => {}};
		&path_walk($rule, \&mark_topology);
	    }
	}
 
	# Mark crypto definitions which are referenced by
	# already marked interfaces.    
	if (my $crypto = $interface->{hub} || $interface->{spoke}) {
	    $crypto->{is_used} = 1;
	    my $type = $crypto->{type};
	    $type->{is_used} = 1;
	    $type->{key_exchange}->{is_used} = 1;
	}
    }

    # Mark radius servers referenced in attribute radius_servers.
    if ($router->{radius_servers}) {
	for my $host (@{$router->{radius_servers}}) {

	    # Take an arbitrary interface and get the interface 
	    # in direction to $host.
	    my ($src) = 
		Netspoc::path_auto_interfaces($router->{interfaces}->[0], 
					     $host);
	    my $rule = {src => $src, dst => $host, srv => {}};
	    &path_walk($rule, \&mark_topology);
	}
    }
}

for my $obj (values %areas, values %anys,values %networks, values %hosts,
	     values %routers) 
{
    next if not $obj->{is_used};
    if (my $owner = $obj->{owner}) {
	$owner->{is_used} = 1;
    }
}
for my $area (values %areas) {
    next if not $area->{is_used};
    my $router_attributes = $area->{router_attributes} or next;
    if (my $owner = $router_attributes->{owner}) {
	$owner->{is_used} = 1;
    }
}
for my $owner (values %owners) {
    next if not $owner->{is_used};
    for my $admin (@{ $owner->{admins} }) {
	$admin->{is_used} = 1;
    }
}	
    
# Print marked parts of netspoc configuration.
# Routers and networks have been marked by mark_topology.
# Services have been marked while %expanded_rules have been processed above.
# Groups and servicegroups objects have been marked during expand_policies.
for my $object (
    values %routers,
    values %networks,
    values %anys,
    values %areas,
    values %groups,
    values %services,
    values %servicegroups,
    values %isakmp,
    values %ipsec,
    values %crypto,
    values %owners,
    values %admins
  )
{
    if ($object->{is_used}) {

        # There are some internal objects without src_code.
        if (my $src_code = $object->{src_code}) {
            print $src_code, "\n";
        }
    }
}

# Source of pathrestrictions can't be used literally,
# but must be reconstructed from internal data structure.
for my $restrict (values %pathrestrictions) {
    my $used = 0;
    for my $interface (@{ $restrict->{elements} }) {
        if ($interface->{router}->{is_used}) {
            $used++;
        }
        else {
            $interface = undef;
        }
    }
    next if $used < 2;
    print "$restrict->{name} =\n";
    for my $interface (@{ $restrict->{elements} }) {
        next unless $interface;
        print " $interface->{name},\n";
    }
    print ";\n";
}

# Find global NAT definitions which are bound by used interfaces.
if (keys %global_nat) {
    my %used_nat;
    for my $interface (values %interfaces) {
        $interface->{router}->{is_used} or next;
        my $nat_tag = $interface->{bind_nat} or next;
        $used_nat{$nat_tag} = 1;
    }
    for my $nat_tag (keys %global_nat) {
        next unless $used_nat{$nat_tag};
        print $global_nat{$nat_tag}->{src_code}, "\n";
    }
}

# All unwanted policies have already been deleted above.
for my $policy (values %policies) {
    print $policy->{src_code}, "\n";
}
