#!/usr/bin/perl

# acltest.pl
# Test an IP against a Cisco ACL for address matches.
# Copyright 2011, Chris Bidwell <chris (at) chrisbidwell.com>
#
# 0.0.0.11

use utf8;
	#This is an old version, kept around for posterity and reference:
	#$pattern = /(permit|deny)\s+(\w+)\s+(any|host \d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}|\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\s\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}).*\s+(any|host \d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}|\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\s\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}).*/;

my $debug = 0;
my $html = 1;
my $interactive = 0;
if ($#ARGV >= 0)
{
	if ($ARGV[0] ne "" && $ARGV[0] eq "-i")
	{
		$interactive++;
	}
}

my $action, $protocol, $source, $destination;

my $host_pattern = 'host \d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}';
my $cidr_pattern = '\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\/[1-3]?\d';
my $masked_pattern = '\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\s\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}';
my $interface_pattern = 'interface [\w\d_-]+';
my $element_pattern = 'any|'.$host_pattern.'|'.$masked_pattern.'|'.$cidr_pattern.'|'.$interface_pattern;
my $unmatched_element_pattern = '(?:'.$element_pattern.')';
my $matched_element_pattern = '('.$element_pattern.')';
my $pattern = '(?:^access-list\s+(?:[\w\d_-]+)\s+.*?(?:\bextended)?\s+)?(permit|deny)\s+(?:([\w\s]+)\s)?'.$matched_element_pattern.'.*?\s+'.$matched_element_pattern.'.*';
my $srcreplacepattern = '(.*?(?:permit|deny)\s+(?:(?:[\w\s]+)\s+)?)'.$matched_element_pattern.'(.*?\s+'.$unmatched_element_pattern.'.*)';
my $destreplacepattern = '(.*?(?:permit|deny)\s+(?:(?:[\w\s]+)\s+)?(?:(?:<span.*?>)*)?'.$unmatched_element_pattern.'(?:(?:<\/span>)*)?.*\s+)'.$matched_element_pattern.'(.*)';
my $asaaclnamepattern = '^access-list\s+([\w\d_-]+)\s+.*?(?:\bextended)?\s+(?:permit|deny)\s+(?:[\w\s]+)\s+'.$unmatched_element_pattern.'.*?\s+'.$unmatched_element_pattern.'.*';
my $asaacepattern = '^access-list\s+([\w\d_-]+)\s+.*?(?:\bextended)?\s+(permit|deny)\s+([\w\s]+)\s+'.$matched_element_pattern.'.*?\s+'.$matched_element_pattern.'.*';

my $test_ipstr = "172.16.0.0 0.0.0.255";
my $test2_ipstr = "172.16.1.0 0.0.0.255";

my $test_component = "2";

my $test_sources = 0;
my $test_destinations = 0;
my $test_2 = 0;

my $asa_style = 0;
my $asa_component_style = 0;

my @aces = ("deny ip any any",
			"permit ip any 172.16.0.0 0.0.255.255",
			"deny icmp 172.16.0.0 0.0.255.255 host 172.16.1.2",
			"permit igmp any any");

my $ACL = "deny ip any any
permit ip any 172.16.0.0 0.0.255.255
deny icmp 172.16.0.0 0.0.255.255 host 172.16.1.2
permit igmp any any
permit tcp 172.16.0.0/24 172.16.1.0/24
deny ip any any
access-list outbound permit tcp any any
access-list RDP extended permit tcp any interface outside eq 3389 log
access-list RDP extended permit tcp interface outside interface inside eq 3389 log
access-list inside-in extended permit tcp 192.168.20.0 255.255.255.0 host 198.133.219.25 eq 80
access-group inside-in in interface inside
access-list outside-in extended deny ip any any log
access-list outside-in extended deny tcp host 172.16.0.225 host 172.16.1.2 log
access-list outside-in extended permit udp host 172.16.0.225 host 172.16.1.2 log
access-list outside-in extended deny ip 172.17.0.0 255.254.0.0 172.16.1.0 255.255.255.0 log
access-list outside-in extended deny ip 172.16.0.0 255.255.0.0 172.16.1.0 255.255.255.0 log
access-list outside-in extended deny ip 172.16.0.0 255.255.255.0 172.16.1.0 255.255.255.0 log
access-list 10 permit any any
access-list 20 permit 172.16.0.0 0.0.0.255 host 172.16.1.2
access-list 20 permit ip 172.16.0.0 0.0.0.255 host 172.16.1.2
access-list 30 deny ip any any
permit ip 172.16.0.0 0.0.255.255 172.16.0.0 0.0.255.255
permit ip 172.16.0.0 0.0.0.255 172.16.1.0 0.0.1.255";

#$ACL = "access-list outside-in extended permit udp host 172.16.0.225 host 172.16.1.2 log
#access-list outside-in extended deny ip 172.17.0.0 255.254.0.0 172.16.1.0 255.255.255.0 log
#access-list outside-in extended deny ip 172.16.0.0 255.255.255.0 172.16.1.0 255.255.255.0 log
#access-list 10 permit any any
#permit ip 172.16.0.0 0.0.255.255 172.16.0.0 0.0.255.255
#permit ip 172.16.0.0 0.0.0.255 172.16.1.0 0.0.1.255";

@aces = split(/\n/, $ACL);



#if an interactive arg was passed, read from stdin:
if ($interactive)
{
	print "Enter the element to test (use wildcard, IOS-style ACL notation even when supplying ASA-style ACLs. For a single IP, use 'host x.x.x.x'. For 172.16.0.0/24 use '172.16.0.0 0.0.0.255'):\n";
	$test_ipstr = <STDIN>;
	chomp($test_ipstr);
	
	print "Do you want to test this 1 address against 's'ources, 'd'estinations or 'b'oth? '2' to enter a second address to be dest in a source/dest pair test. s/d/b/2: [b] ";
	$test_component = <STDIN>;
	chomp($test_component);
	if ($test_component ne "" && $test_component ne "d" && $test_component ne "s" && $test_component ne "2" && $test_component ne "b") { die("Invalid entry"); }
	if ($test_component eq "b") { $test_component = ""; }
	if ($test_component eq "2")
	{
		print "Enter the second element:\n";
		$test2_ipstr = <STDIN>;
		chomp($test2_ipstr);
	}
	if ($test_ipstr =~ $masked_pattern && ($test_component ne "2" || ($test2_ipstr =~ $masked_pattern)))
	{
		if ($test_component eq "2") { print "Were the masked addresses"; }
		else { print "Was the masked address"; }
		print " you entered in ASA-style formatting? y/n: [n] ";
		my $asa_componentstr = <STDIN>;
		chomp($asa_componentstr);
		if ($asa_componentstr eq "y") { $asa_component_style++; }
	}
	
	print "Enter the ACL to check: (Ctrl+D on a blank-line to end)\n";
	@aces = <STDIN>;
}


my $name,$value,$pair,@pairs,$buffer;

$ENV{'REQUEST_METHOD'} =~ tr/a-z/A-Z/;
if ($ENV{'REQUEST_METHOD'} eq "POST")
{
	read(STDIN,$buffer,$ENV{'CONTENT_LENGTH'});
}
elsif ($ENV{'REQUEST_METHOD'} eq "GET")
{
	$buffer = $ENV{'QUERY_STRING'};
}
if ($buffer)
{
	$html = 1;
	@pairs = split(/&/,$buffer);
	foreach $pair (@pairs)
	{
		($name,$value) = split(/=/,$pair);
		$value =~ tr/+/ /;
		$value =~ s/%(..)/pack("C",hex($1))/eg;
		$value =~ s/\!br\!/\n/g;
		if ($name eq "test")
		{
			$test_ipstr = $value;
		}
		elsif ($name eq "test2")
		{
			$test2_ipstr = $value;
		}
		elsif ($name eq "component")
		{
			$test_component = $value;
		}
		elsif ($name eq "asacomponents")
		{
			$asa_component_style = $value;
		}
		elsif ($name eq "acl")
		{
			@aces = split(/\n/, $value);
		}
	}
}


if ($html)
{
	print <<"HTML";
<html>
<head>
<title>ACLTest</title>
<style type="text/css">
	body { font-family: Consolas, 'Courier New', 'Lucida Console', Monaco, monospace; }
	.nomatch {}
	.pmatch { font-weight: bold; color: rgb(20,150,20); }
	.dmatch { font-weight: bold; color: rgb(200,0,0); }
	.match { font-weight:bold; color: rgb(255,105,180); }
	.srcmatch { background-color: rgb(255,255,0); }
	.destmatch { background-color: rgb(191,239,255); }
	.exactsrcmatch { background-color: rgb(255,193,37); }
	.exactdestmatch { background-color: rgb(0,191,255); }
</style>
<script type="text/javascript">
	//changeRule mostly plagiarised from Flip @ http://twelvestone.com/forum_thread/view/31411
	function changeRule(theNumber)
	{
		var theRules = new Array();
		var link = document.getElementById('toggle');
		if (document.styleSheets[0].cssRules)
		{
			theRules = document.styleSheets[0].cssRules;
		}
		else if (document.styleSheets[0].rules)
		{
			theRules = document.styleSheets[0].rules;
		}
		if (theRules[theNumber].style.display == "none")
		{
			theRules[theNumber].style.display = "inline";
			link.innerHTML = "Hide unmatched lines";
		}
		else
		{
			theRules[theNumber].style.display = "none";
			link.innerHTML = "Show unmatched lines";
		}
	}
	
	function toggleUnmatchedVisible()
	{
		changeRule(1);
	}
</script>
</head>
<body>
<p><a href="javascript:toggleUnmatchedVisible();" id="toggle">Hide unmatched lines</a></p>
<p>
HTML
}
print "\nTest element: $test_ipstr; ";
if ($test_component eq "2")
{
	print "2nd test element: $test2_ipstr; ";
	$test_2 = 1;
}
print "checking against ";
if ($test_component eq "")
{
	print "both sources and destinations";
	$test_sources = 1;
	$test_destinations = 1;
}
elsif ($test_component eq "s")
{
	print "sources";
	$test_sources = 1;
}
elsif ($test_component eq "d")
{
	print "destinations";
	$test_destinations = 1;
}
elsif ($test_component eq "2")
{
	print "both individual address elements";
}
else
{
	print "magic";
}
if ($html) { print "</p>\n<p>\n"; }
else { print "\n\n"; }

if ($asa_component_style)
{
	if ($test_ipstr =~ $masked_pattern)
	{
		my @addr_ = split /\s/, $test_ipstr;
		my @mask_components = split /\./, $addr_[1];
		foreach (@mask_components) { $_ = 255-$_; }
		$test_ipstr = $addr_[0]." ".join(".",@mask_components);
	}
	if ($test2_ipstr =~ $masked_pattern)
	{
		my @addr_ = split /\s/, $test2_ipstr;
		my @mask_components = split /\./, $addr_[1];
		foreach (@mask_components) { $_ = 255-$_; }
		$test2_ipstr = $addr_[0]." ".join(".",@mask_components);
	}
}




foreach $ace (@aces)
{
	my $match = 0;
	my $ace_ = $ace;
	$asa_style = ($ace =~ $asaacepattern);
	if ($debug && $asa_style) { print "Interpreting this line as an ASA-style line: $ace\n"; }
	if ($debug)
	{
	
		print "$ace =~ $pattern\n";
		$ace =~ $pattern;
		print "1: $1, 2:$2, 3:$3, 4:$4\n";
	}
	if (($action,$protocol,$source,$destination) = ($ace =~ $pattern))
	{
		chomp($ace);
		
		if ($debug)
		{
			print "\t\t\t\taction=$action\n";
			print "\t\t\t\tprotocol=$protocol\n";
			print "\t\t\t\tSource address: $source\n";
			print "\t\t\t\tDestination address: $destination\n";
		}
		
		my $srcmatch = checkainb(normalise_addr($source)." ".normalise_addr($test_ipstr));
		if ($debug) { print "srcmatch: $srcmatch\n"; }
		if (($test_sources || $test_2) && $srcmatch)
		{
			if ($debug) { print "\t!SOURCE match: $source\n"; }
			$match++;
			if ($html)
			{
				if ($srcmatch == 2)
				{
					if ($debug) { print "!exactmatchSRC!\n"; }
					$ace =~ s/$srcreplacepattern/\1<span class=srcmatch><span class=exactsrcmatch>\2<\/span><\/span>\3/;
				}
				else
				{
					if ($debug) { print "!NONexactmatchSRC!\n"; }
					$ace =~ s/$srcreplacepattern/\1<span class=srcmatch>\2<\/span>\3/;
				}
			}
			else
			{
				
			}
		}
		my $dest1match = 0;
		my $dest2match = 0;
		if ($test_2) { $dest2match = checkainb(normalise_addr($destination)." ".normalise_addr($test2_ipstr)); }
		else { $dest1match = checkainb(normalise_addr($destination)." ".normalise_addr($test_ipstr)); }
		if ($debug) { print "dest1match: $dest1match, dest2match: $dest2match\n"; }
		if (($test_destinations && $dest1match) || ($test_2 && $dest2match))
		{
			if ($debug) { print "\t!DESTINATION match: $destination\n"; }
			$match++;
			if ($html)
			{
				if (($test_2 && ($dest2match == 2)) || (!$test_2 && ($dest1match == 2)))
				{
					if ($debug) { print "!exactmatchDEST!\n"; }
					$ace =~ s/$destreplacepattern/\1<span class=destmatch><span class=exactdestmatch>\2<\/span><\/span>\3/;
				}
				else
				{
					if ($debug) { print "!NONexactmatchDEST!\n"; }
					$ace =~ s/$destreplacepattern/\1<span class=destmatch>\2<\/span>\3/;
				}
			}
		}

		if ($html)
		{
			if ($debug) { print "MATCHVAL=$match\n"; }
			if (($test_2 && ($match == 2)) || (!$test_2 && $match))
			{
				print "<span class=";
				if ($action eq "permit")
				{
					print "pmatch";
				}
				elsif ($action eq "deny")
				{
					print "dmatch";
				}
				else
				{
					print "match";
				}
				print ">";
				$ace .= "<br/></span>";
			}
			else { $ace = "<span class=nomatch>$ace_<br/></span>"; }
			print $ace."\n";
		}
		else
		{
			if (($test_2 && ($match == 2)) || (!$test_2 && $match))
			{
				print $ace,"\n";
			}
		}
	}
	else
	{
		if ($debug) { print "\t\t\t!Ignoring this line because it didn't give us a regex matchP: $ace\n"; }
		if ($html) { print "<span class=nomatch>$ace<br/></span>\n"; }
	}
}
if ($html) { print "</p>\n</body>\n</html>\n"; }


#normalise_addr
# params: ACL-style address construct. any, host x.x.x.x, x.x.x.x y.y.y.y, x.x.x.x/nn
# returns: (IOS) ACL-style wildcard address construct, x.x.x.x y.y.y.y

sub normalise_addr
{                      
	if ($debug) { print "\t\t\t\tsub normalise_addr\n"; }
	my $retval;
	if ($#_>=0)
	{
		my $addr = $_[0];
		if ($debug) { print "\t\t\t\tAddr: $addr\n"; }
		if ($addr =~ $masked_pattern)
		{
			$retval = $addr;
		}
		elsif ($addr =~ $cidr_pattern)
		{
			if ($debug) { print "\t\t\t\tConverting CIDR to wildcard mask\n"; }
			$addr =~ /(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})\/([1-3]?\d)/;
			my $addr_ = $1;
			my $mask_len_ = $2;
			my $binmask_ = '0'x$mask_len_ . '1'x(32-$mask_len_);
			my @binmask_octets_ = split(/([01]{8})/,$binmask_);
			my @mask_octets_;
			for ($i=1; $i<8; $i+=2)
			{
				if ($debug) { print "$binmask_octets_[$i]\t:\t"; }
				$binmask_octets_[$i] = unpack("N",pack("B32", substr("0" x 32 . $binmask_octets_[$i], -32)));
				if ($debug) { print "$binmask_octets_[$i]\n"; }
				push(@mask_octets_,$binmask_octets_[$i]);
			}
			
			my $mask = join('.',@mask_octets_);
			$retval = "$addr $mask";
			
		}
		elsif ($addr =~ $host_pattern)
		{
			if ($debug) { print "\t\t\t\tCreating a host IP\n"; }
			$addr =~ /(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/;
			my $addr_ = $1; 
			if ($asa_style)
			{
				$retval = $addr_." 255.255.255.255";
			}
			else
			{
				$retval = $addr_." 0.0.0.0";
			}
		}
		elsif ($addr =~ $interface_pattern)
		{
			if ($debug) { print "\t\t\t\tInterface patterns can't be tested, returning empty string\n"; }
			if ($asa_style)
			{
				$retval = "0.0.0.0 255.255.255.255";
			}
			else
			{
				$retval = "0.0.0.0 0.0.0.0";
			}
			
		}
		else
		{
			if ($asa_style)
			{
				if ($debug) { print "\t\t\t\tCreating an IP of 0.0.0.0/0 in ASA-style\n"; }
				$retval = "0.0.0.0 0.0.0.0";
			}
			else
			{
				if ($debug) { print "\t\t\t\tCreating an IP of 0.0.0.0/0\n"; }
				$retval = "0.0.0.0 255.255.255.255";
			}
		}
	}
	else
	{
		if ($debug) { print "\t\t\t\tno args\n"; }
	}
	if ($debug) { print "\t\t\t\tReturning retval $retval\n"; }
	return $retval;
}

#checkainb
# params: 2 space separated ACL-style address constructs to test if A is in B
# returns: true if A is in B, false otherwise.

sub checkainb
{
    my ($sip, $smask, $tip, $tmask) = split /\s/, $_[0];
    my $b_sip        = pack "C4", split /\./, $sip; 
    my $b_tip        = pack "C4", split /\./, $tip; 
    my $b_smask      = pack "C4", split /\./, $smask;
    my $b_tmask      = pack "C4", split/\./, $tmask;

	my @tmask_octets_ = split /\./, $tmask;
	foreach (@tmask_octets_) { $_ = 255-$_; }
	my $tmask_ = join(".",@tmask_octets_);

	if ($debug)
	{
		print "checkainb()\n";
		print "\t\t\t\tsip:$sip,$b_sip;mask:$smask,$b_smask;tip:$tip,$b_tip;tmask:$tmask,$b_tmask\n";
		printf "\t\t\t\tsip:%b\n",unpack("N", $b_sip);
		printf "\t\t\t\ttip:%b\n",unpack("N",$b_tip);
		printf "\t\t\t\tsmask:%b\n",unpack("N",$b_smask);
		printf "\t\t\t\ttmask:%b\n",unpack("N",$b_tmask);
		print "\t\t\t\ttmask_:$tmask_\n";
	}
	
	my $b_smaskinv = ~$b_smask;
	my $b_tmaskinv = ~$b_tmask;
	my $g,$h,$i;
	if ($asa_style)
	{
		if ($debug) { print "\t\t\t\tASA-style, not flipping masks, using smask and tmaskinv\n"; }
		$g = $b_smask & $b_tip;
#		printf "\t\t\t\tSPECIAL:%b\n",unpack("N",($b_sip & $b_smaskinv));
#		$h = $b_smask & ($b_sip & $b_smaskinv);
		$h = $b_smask & $b_sip;
	}
	else
	{
		if ($debug) { print "\t\t\t\tIOS-style, flipping masks, using smaskinv and tmaskinv\n"; }
		$g = $b_smaskinv & $b_tip;
		$h = $b_smaskinv & $b_sip;
	}

	$i = $g ^ $h;
	if ($debug)
	{	
		printf "\t\t\t\tsmaskinv:%b\n",unpack("N",$b_smaskinv);
		printf "\t\t\t\ttmaskinv:%b\n",unpack("N",$b_tmaskinv);
		printf "\t\t\t\tg:%b\n",unpack("N",$g);
		printf "\t\t\t\th:%b\n",unpack("N",$h);
		printf "\t\t\t\ti:%b\n",unpack("N",$i);
		
		#EXPERIMENTALS!!!
		if ($b_tmaskinv gt $b_smask) { print "b_tmaskinv gt b_smask\n"; }
		if ($b_tmask gt $b_smask) { print "b_tmask gt b_smask\n"; }
		if ($b_tmaskinv gt $b_smaskinv) { print "b_tmaskinv gt b_smaskinv\n"; }
		if ($b_tmask gt $b_smaskinv) { print "b_tmask gt b_smaskinv\n"; }
		if ($b_tmaskinv eq $b_smaskinv) { print "b_tmaskinv eq b_smaskinv\n"}
		if ($b_tmaskinv eq $b_smask) { print "b_tmaskinv eq b_smask\n"}
		if ($b_tmask eq $b_smaskinv) { print "b_tmask eq b_smaskinv\n"}
		if ($b_tmask eq $b_smask) { print "b_tmask eq b_smask\n"}
		if ($b_smaskinv gt $b_tmask) { print "b_smaskinv gt b_tmask\n"; }
		if ($b_smask gt $b_tmask) { print "b_smask gt b_tmask\n"; }
		if ($b_smaskinv gt $b_tmaskinv) { print "b_smaskinv gt b_tmaskinv\n"; }
		if ($b_smask gt $b_tmaskinv) { print "b_smask gt b_tmaskinv\n"; }
		if ($b_smaskinv eq $b_tmaskinv) { print "b_smaskinv eq b_tmaskinv\n"}
		if ($b_smaskinv eq $b_tmask) { print "b_smaskinv eq b_tmask\n"}
		if ($b_smask eq $b_tmaskinv) { print "b_smask eq b_tmaskinv\n"}
		if ($b_smask eq $b_tmask) { print "b_smask eq b_tmask\n"}

		print "\n";
	}
	
	if (unpack("N",$i) == 0)
	{
		if ((!$asa_style && "$sip $smask" eq "$tip $tmask") || ($asa_style && "$sip $smask" eq "$tip $tmask_"))
		{
			if ($debug) { print "!Exact match!\n"; }
			return 2;
		}
		elsif (($asa_style && $b_smask gt $b_tmaskinv) || (!$asa_style && $b_smaskinv gt $b_tmaskinv))
		{
			if ($debug) { print "the source mask was more specific than our test mask, so it couldn't match completely and is therefore not a match.\n"; }
			return 0;
		}
		else
		{
			return 1;
		}
	}
	else
	{
		return 0;
	}
}