#!/usr/local/bin/perl -- -*-Perl-*-
#
# Paul Traina (Feburary 1994)
#
# Common data and subrouines to help in generating network access
# control lists.
#
#--------------------------------------------------------------------

#
# All corporate networks that are trusted.
#
# This list is used to generate "network" statements and ACL entries.
# It absolutely MUST be kept up to date.
#
# Keep these lists in numeric order or I will kill you! (-- pst)
#
# The following networks should NOT appear inside @networks.
#	192.31.7/24			# the dirty network
#	206.100.224/24			# the RTP dirty network
#	144.254/16			# the show network
#
@networks = (
        "172.68.0.0 0.1.255.255",	# CIDR block
	"192.83.152.0",			# old class C network
);

#
# The following are sub-blocks contained inside cisco_networks that
# need to be special-case filtered (sigh).
#
@insecure_networks = (
	"192.31.7.0 0.0.0.255",		# external dirty network
	"206.100.224.0 0.0.0.255",	# external dirty network
);

@multicast = (
	"224.0.0.0 15.255.255.255"	# entire class D range
);

@anyone = ( "0.0.0.0 255.255.255.255" );

@rfc1918 = (
	"10.0.0.0    0.255.255.255",
	"172.16.0.0   0.15.255.255",
	"192.168.0.0   0.0.255.255"
);

%protocols = (
	"igmp",  2,			# internet gateway management protocol
	"ipip",  4,			# IP over IP (multicast encaps)
	"gre",  47,			# GRE multiprotocol over IP tunneling
	"eon",  80,			# EON CLNP over IP tunneling
	"rsrb", 90,			# FST RSRB
	"axip", 93,			# AX.25 over IP tunneling
	"nos",  94,			# NOS IP over IP tunneling
);

%ports = (
	"ftp-data",		"eq 20",	# tcp
	"ftp-cmd",		"eq 21",	# tcp
	"telnet",		"eq 23",	# tcp
	"smtp",			"eq 25",	# tcp
	"tacacs",		"eq 49",	# udp
	"tacacs-ds",		"eq 65",	# udp
	"dns",			"eq 53",	# tcp & udp
	"tftp",			"eq 69",	# udp
	"finger",		"eq 79",	# tcp
	"www",			"eq 80",	# tcp
	"kerberos5",		"eq 88",	# tcp & udp
	"pop",			"eq 110",	# tcp
	"pop2",			"eq 109",	# tcp
	"pop3",			"eq 110",	# tcp
	"sunrpc",		"eq 111",	# tcp & udp (portmapper)
	"ident",		"eq 113",	# tcp
	"nntp",			"eq 119",	# tcp
	"ntp",			"eq 123",	# udp
	"NeWS",			"eq 144",	# tcp
	"snmp",			"eq 161",	# tcp & udp
	"snmp-trap",		"eq 162",	# udp
	"bgp",			"eq 179",	# tcp
	"prospero",		"eq 191",	# tcp (archie)
	"aurp",			"eq 387",	# udp
	"qtc-conf",		"eq 458",	# tcp (QuickTime Conferencing)
	"rexec",		"eq 512",	# tcp
	"rlogin",		"eq 513",	# tcp
	"rsh",			"eq 514",	# tcp
	"syslog",		"eq 514",	# udp (syslog)
        "printer",		"eq 515",	# tcp (lpr)
	"talk",			"eq 517",	# udp
	"ntalk",		"eq 518",	# udp
	"klogin",		"eq 543",	# tcp (kerberos)
	"kshell",		"eq 544",	# tcp (kerberos)
	"qtc-bcst",		"eq 545",	# tcp (QuickTime Conferencing)
	"kerberos-adm",		"eq 749",	# tcp and udp (kerberos)
	"kerberos-sec",		"eq 750",	# tcp and udp (kerberos auth)
	"kerberos_master",	"eq 751",	# tcp and udp (kerberos)
	"passwd_server",	"eq 752",	# udp (kerberos)
	"userreg_server",	"eq 753",	# udp (kerberos)
	"krb_prop",		"eq 754",	# tcp (kerberos)
	"supfilesrv",		"eq 871",	# tcp (sup)
	"erlogin",		"eq 888",	# tcp (kerberos)
	"kpop",			"eq 1109",	# tcp (kerberos)
	"supfiledbg",		"eq 1127",	# tcp (sup)
	"sqlnet-alt",		"eq 1521",	# tcp (Oracle SQL net)
	"dirsrv",		"eq 1525",	# udp (archie)
	"sqlnet",		"eq 1525",	# tcp (Oracle SQL net)
	"streamworks",		"eq 1558",	# udp (BOGUS...Streamworks A/V)
	"openwin",		"eq 2000",	# actually 2000-2015
	"openwin:1",		"eq 2001",
	"openwin:2",		"eq 2002",
	"openwin-range",	"range 2000 2063",
	"nfs",			"eq 2049",	# rpc service but usually fixed
	"eklogin",		"eq 2105",	# tcp (kerberos encrypted login)
	"x11",			"eq 6000",	# acutally 6000-6015
	"x11:1",		"eq 6001",
	"x11:2",		"eq 6002",
	"x11-range",		"range 6000 6063", # X11 (TCP)
	"vat",			"range 3456 3457", # udp vat defaults
	"cuseeme",		"range 7648 7651", # tcp CuSeeMe
	"bbsfwd",		"eq 44520"	# tcp see pst@cisco.com
);

########################################################################
#####
#####	Subroutines
#####
########################################################################

#
# header_prelude (public)
#
# print record keeping verbage
#

sub header_prelude {
     local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
	localtime(time);
     local($today) = sprintf("%d-%-2.2d-%-2.2d %-2.2d:%-2.2d",
			     1900 + $year, $mon+1, $mday, $min, $hour);
     local($user) = $ENV{'USER'};

     print "! this file is automaticly generated by $0\n";
     print "! do not edit by hand\n";
     print "! generated $today by $user\n";
     print "!\n";
}

#
# start_list (public)
#
# do housekeeping necessary at the start of list generation
#

sub start_list {
    $_ = @_[0];

    $_alnum = $_;
    print "no access-list $_alnum\n";
}

#
# entry (public)
#
# create an extended access list entry (or entries) based upon
# passed parameters
#

sub entry {
    local($grant, $proto, $mod, @nets) = @_;
    local($net, @sources, @dests);
    local($dodest) = 0;

    $proto = $protocols{$proto} unless $protocols{$proto} eq "";
    $mod = $ports{$mod} unless $ports{$mod} eq "";

    $log = "";
    $log = " log" if ($grant =~ /-log$/ && $new_acl_format);
    $grant =~ s/-.*//;

    foreach $net (@nets) {
	if ($net eq "*") {
	    $dodest++;
	    next;
	}
	if ($dodest > 0) {
	    push(@dests, $net);
	} else {
	    push(@sources, $net);
	}
    }

    foreach $source_id (@sources) {
	foreach $source (&_mung_addr($source_id)) {
	    foreach $dest_id (@dests) {
		foreach $dest (&_mung_addr($dest_id)) {
		    print "access-list $_alnum $grant $proto $source $dest $mod$log\n";
		}
	    }
	}
    }
}

#
# fast_entry (public)
#
# Create a fast access list entry (or entries)
#

sub fast_entry {
    local($grant, @nets) = @_;
    local($net);

    foreach $net_id (@nets) {
	foreach $net (&_mung_addr($net_id)) {
	    print "access-list $_alnum $grant $net\n";
	}
    }
}

########################################################################
#####
#####	Policy database stuff
#####
########################################################################

#
# read_policy
#
# Read time based access policy information from a data file
# and produce access list entries suitable for terminal server
# vty access lines.
#
# policy lines look like this:
# user:source:start:end[:comment]

sub read_policy {
    local($file) = @_[0];

    local($user,$source,$start,$end,$today);
    local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
	localtime(time);
    $today = sprintf("%d-%-2.2d-%-2.2d", 1900 + $year, $mon+1, $mday);

    open(POLICY, $file) || die "no data file $file found";

    print "! reading policy from $file\n";
    print "!\n";

    while(<POLICY>) {
	chop;
	next if (/^\#/ || /^\!/ || /^$/); # skip comment lines
	($user,$source,$start,$end,$comment) = split(':', $_, 5);
	if ((&validdate($start) != 1) ||
	    (&validdate($end) != 1)) {
	    print STDERR "ignoring line $. \'$_\'\n";
	    next;
	}

	# do we need to worry about this time yet?
	if ((&comparedate($today,$start) < 0) ||
	    (&comparedate($today,$end) > 0)) {
	    next;
	}
	print "! $user from $start to $end\n";
	print "! $comment\n" if ($comment ne '');
	&fast_entry("permit", $source);
    }

    close(POLICY);
}

sub comparedate {
    local($date1, $date2) = @_;
    local($result) = 0;

    ($y1, $m1, $d1) = split('-',$date1);
    ($y2, $m2, $d2) = split('-',$date2);

    if ($y1 < $y2) {
	$result = -1;
    }
    elsif ($y1 > $y2) {
	$result = 1;
    }
    elsif ($m1 < $m2) {
	$result = -1;
    }
    elsif ($m1 > $m2) {
	$result = 1;
    }
    elsif ($d1 < $d2) {
	$result = -1;
    }
    elsif ($d1 > $d2) {
	$result = 1;
    }
    $result;
}

sub validdate {
    local($date) = @_;
    local($y, $m, $d) = split('-',$date);

    if (($y < 1900) ||
	($m < 1) || ($m > 12) ||
	($d < 1) || ($d > 31)) {
	print STDERR "bogus date $y-$m-$d\n";
	return 0;
    }
    return 1;
}

########################################################################
#####
#####	Private subroutines
#####
########################################################################

#
# _mung_addr (private)
#
# convert a text entry into a group of dotted decimal addresses
#
# Addresses can be of the form:
#  net mask
#  hostname
#  host address
#
#
sub _mung_addr {
    local (@retval);
    $_ = @_[0];

    if (/^any$/ || /^0\.0\.0\.0\s+255\.255\.255\.255$/) {
	if ($new_acl_format) {
	    @retval[0] = "any";
	} else {
	    @retval[0] = "0.0.0.0 255.255.255.255";
	}

    } elsif (/\s+/) {	 # if we have whitespace, it must be a network & mask
	s/\s+/ /;

	@retval[0] = $_;

    } elsif (/^\d+\.\d+.\d+.\d+$/) {
	local ($a, $b, $c, $d ) = split(/\./);
	if ($d != 0) {		# if it's a host
	    $mask = " 0.0.0.0";
	} elsif ($a < 128) {	# class A net
	    $mask = " 0.255.255.255";
	} elsif ($a < 192) {	# class B net
	    $mask = " 0.0.255.255";
	} elsif ($a < 224) {	# class C net
	    $mask = " 0.0.0.255";
	} else {
	    die "Invalid address: $_";
	}
		
	@retval[0] = $_ . $mask;

    } else {
	local ($name, $aliases, $type, $len, @addrs) = gethostbyname($_);
	local ($a, $b, $c, $d);
	local ($addr);

	if ($#addrs < 0) {
	    print STDERR "ERROR: cannot resolve hostname $_\n";
	}

	foreach $addr (@addrs) {
	   ($a, $b, $c, $d) = unpack('C4', $addr);
	   if ($new_acl_format) {
	       push (retval, "host $a.$b.$c.$d");
	   } else {
	       push(retval, "$a.$b.$c.$d 0.0.0.0");
	   }
	}
    }
    @retval;
}

# -------------------------------------------------------------------------
# $Log$
#
# -------------------------------------------------------------------------
