#!/usr/bin/perl

# acl2filter.pl
# Create a tcpdump filter from a Cisco ACL.
# Copyright 2011, Chris Bidwell <chris (at) chrisbidwell.com>
#
# 0.0.0.3

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 $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;
my $unmatched_element_pattern = '(?:'.$element_pattern.')';
my $matched_element_pattern = '('.$element_pattern.')';
my $port_pattern = '(?:\d{1,5}|[\w-]+)';
my $matched_port_pattern = '(\d{1,5}|[\w-]+)';
my $eq_pattern = 'eq (?:'.$port_pattern.'\s?)+';
my $lt_pattern = 'lt '.$port_pattern;
my $gt_pattern = 'gt '.$port_pattern;
my $range_pattern = 'range '.$port_pattern.'\s+'.$port_pattern;
my $neq_pattern = 'neq '.$port_pattern;
my $singleportarg_operators_pattern = 'gt|lt|neq';
my $twoportarg_operators_pattern = 'range';
my $multiportarg_operators_pattern = 'eq';
my $operator_pattern = $eq_pattern.'|'.$lt_pattern.'|'.$gt_pattern.'|'.$range_pattern.'|'.$neq_pattern;
my $service_element_pattern = '('.$operator_pattern.')?\s?';
my $established_pattern = 'established';
my $pattern = '(?:^access-list\s+(?:[\w\d_-]+)\s+.*?(?:\bextended)?\s+)?(permit|deny)\s+(?:([\w\s]+)\s)?'.$matched_element_pattern.'\s?.*?'.$service_element_pattern.'.*?\s?'.$matched_element_pattern.'\s?.*?'.$service_element_pattern.'.*?\s?('.$established_pattern.')?.*(?:log(?:-input)?)?';
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 $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
access-list 20 permit ip 172.16.0.0 0.0.0.255 eq 443 host 172.16.1.2 gt netbios-ssn established";

$ACL = "deny ip any any
permit tcp 172.16.0.0/24 172.16.1.0/24
permit igmp any any
access-list 20 permit tcp 172.16.0.0 0.0.0.255 eq 443 host 172.16.1.2 gt 139 established
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-list inside-in extended permit tcp 192.168.20.0 255.255.255.0 host 198.133.219.25 eq 80 443 8080 8082
access-list outbound permit tcp any any
permit pim any any";



#$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 "Are you entering an ASA-style ACL? 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)
{
	@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 "asacomponents")
		{
			$asa_component_style = $value;
		}
		elsif ($name eq "acl")
		{
			@aces = split(/\n/, $value);
		}
	}
}


my @filters;
my @actions;

foreach $ace (@aces)
{
	my $ace_ = $ace;
	my $filter_;
	$asa_style = ($ace =~ $asaacepattern);
	if ($debug && $asa_style) { print "Interpreting this line as an ASA-style line: $ace\n"; }

	if (($action,$protocol,$source,$sourceport,$destination,$destinationport,$established) = ($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\tSource port: $sourceport\n";
			print "\t\t\t\tDestination address: $destination\n";
			print "\t\t\t\tDestination port: $destinationport\n";
			print "\t\t\t\tEstablished: $established\n";
		}
		
		$filter_ = filterify($action,$protocol,$source,$sourceport,$destination,$destinationport,$established);
		if ($debug) { print "$ace => $filter_\n"; }
		push(@filters,$filter_);
		push(@actions,$action);
	}
	else
	{
		if ($debug) { print "Rejected: $ace\n"; }
	}
	
}

my $joined = "";
my $i;
my $size = @filters;
my $trailing_brackets;

for ($i=0; $i<$size; $i++) 
{ 
	if ($i==0)
	{
		#first one
		$joined.=$filters[$i]
	}
	else
	{
		if ($actions[$i] eq "permit")
		{
			if ($actions[$i-1] eq "permit")
			{
				$joined.=" or ";
			}
			elsif ($actions[$i-1] eq "deny")
			{
				$joined.=" and (";
				$trailing_brackets.=")";
			}
			
		}
		elsif ($actions[$i] eq "deny")
		{
			if ($actions[$i-1] eq "permit")
			{
				$joined.=" or (";
				$trailing_brackets.=")";
				
			}
			elsif ($actions[$i-1] eq "deny")
			{
				$joined.=" and ";
			}
		}
		$joined.=$filters[$i];
	}
}
$joined.=$trailing_brackets;

print "$joined\n";


#filterify_address
# params: ACL-style address component.
# returns: tcpudmp filter-style host or net string.

sub filterify_address
{
	my $addr_ = "";
	if ($#_>=0)
	{
		my $addr = $_[0];
		
		if ($addr =~ $host_pattern || $addr =~ $cidr_pattern) { $addr_ = $addr; }
		if ($addr =~ $cidr_pattern) { $addr_ = "net ".$addr; }
	    if ($addr =~ $masked_pattern)
		{ 
			my ($net,$mask) = split(" ",$addr);

			if (!$asa_style)
			{
				my @mask_octets_ = split /\./, $mask;
				foreach (@mask_octets_) { $_ = 255-$_; }
				$mask = join(".",@mask_octets_);			
			}
			
			$addr_ = "net $net mask $mask";
		}
	}
	
	return $addr_;
}

sub filterify_port
{
	my $port_ = "";
	if ($#_==2 && $_[2] =~ $operator_pattern)
	{
		my $proto = $_[0];
		my $srcdst = $_[1];
		my $port = $_[2];
		my $srcport_field = "[0:2]";
		my $dstport_field = "[2:2]";
		$port_ .= "$proto $srcdst ";
		if ($debug) { print "$port\n"; }
		
		if ($proto eq "tcp" || $proto eq "udp")
		{
			my $field = $proto;
			if ($srcdst eq "src") { $field .= $srcport_field; }
			elsif ($srcdst eq "dst") { $field .= $dstport_field; }
			my $single_pattern_ = "($singleportarg_operators_pattern)".'\s+'.$matched_port_pattern;
			my $two_pattern_ = "($twoportarg_operators_pattern)".'\s+'.$matched_port_pattern.'\s+'.$matched_port_pattern;
			my $multi_pattern_ = "($multiportarg_operators_pattern)".'\s+((?:'.$port_pattern.'\s?)+)';
			if (($port_operator,$port_arg) = ($port =~ $single_pattern_))
			{
				if ($debug) { print "singleport\n"; }
				if ($port_operator eq "lt")
				{
					$port_ = "($field < $port_arg)";
				}
				elsif ($port_operator eq "gt")
				{
					$port_ = "($field > $port_arg)";
				}
				elsif ($port_operator eq "neq")
				{
					$port_ = "not $port_$port_arg";
				}	
			}
			elsif (($port_operator,$port_arg1,$port_arg2) = ($port =~ $two_pattern_))
			{
				if ($debug) { print "twoport\n"; }
				if ($port_operator eq "range")
				{
					$port_ .= "portrange $port_arg1-$port_arg2";
					
					#alternatively...
					#$port_ = "$field >= $port_arg1 and $field <= $port_arg2";
				}
			}
			elsif (($port_operator,$port_arg) = ($port =~ $multi_pattern_))
			{
				if ($debug) { print "multiport\n"; }
				if ($port_operator eq "eq")
				{
					my @ports = split('\s',$port_arg);
					my $ports_or = join(' or ',@ports);
					$port_ .= "port $ports_or";
				}
			}
		}
	}
	return $port_;
}

#filterify
# params: ACL-style components.
# returns: tcpdump filter string

sub filterify
{
	my $f = "";
	if ($#_>=0)
	{
		my ($action,$protocol,$source,$sourceport,$destination,$destinationport,$established) = @_;
		if ($action eq "deny") { $f.="(not "; }
		$f.="(";

		#protocol portion
		if ($protocol eq "tcp" || $protocol eq "udp")
		{
			#port portion
			if ($sourceport ne "")
			{
				my $spf = filterify_port($protocol,"src",$sourceport);
				$f.="$spf ";
				if ($destinationport ne "") { $f.="and "; }
			}
			if ($destinationport ne "")
			{
				my $dpf = filterify_port($protocol,"dst",$destinationport);
				$f.="$dpf ";
			}
			if ($sourceport eq "" && $destinationport eq "")
			{
				$f.="$protocol ";
			}
		}
		elsif ($protocol eq "ip")
		{
			$f.="ip "
		}
		elsif ($protocol eq "icmp")
		{
			$f.="ip proto $protocol ";
		}
		elsif ($protocol eq "pim")
		{
			$f.="ip proto 103 ";
		}
		elsif ($protocol eq "igmp")
		{
			$f.="ip proto 2 ";
		}
		$f.="and ";
		#source portion
		if ($source ne "any")
		{
			$f.="src ";
			$f.=filterify_address($source);
		
			if ($destination ne "any") { $f.=" and"; }
			$f.=" ";
		}
	
		#destination portion
		if ($destination ne "any")
		{
			$f.="dst ";
			$f.=filterify_address($destination);
			$f.=" ";
		}

		#established portion
		if ($protocol eq "tcp" && $established eq "established")
		{
			$f.="and ((tcp[tcpflags] & tcp-ack != 0) or (tcp[tcpflags] & tcp-rst != 0))";
		}
		else
		{
			if (substr($f,length($f)-1,1) eq " ") { chop($f); }
		}
		$f =~ s/\s?and\s?$//;
		if ($action eq "deny") { $f.=")"; }
		$f.=")";
	}
	return $f;
}