#!/usr/pkg/bin/perl

# Convert a format similar to ipftest's "text" form, yet IPv6, to ipftest's "hex" input format.
# Useful for testing IPv6 filter rules.
# Copyright 2012, Edgar Fuß, Mathematisches Institut der Universität Bonn.

use strict;
use warnings;

use Scalar::Util qw/looks_like_number/;

use Net::Frame::Simple;
use Net::Frame::Layer::IPv6 qw/:consts/;
use Net::Frame::Layer::ICMPv6 qw/:consts/;
use Net::Frame::Layer::ICMPv6::Echo;
use Net::Frame::Layer::UDP qw/:consts/;
use Net::Frame::Layer::TCP qw/:consts/;

my %icmp_types = (
	'echo' => NF_ICMPv6_TYPE_ECHO_REQUEST,
	'echorep' => NF_ICMPv6_TYPE_ECHO_REPLY,
	'unrech' => NF_ICMPv6_TYPE_DESTUNREACH,
	'routersol' => NF_ICMPv6_TYPE_ROUTERSOLICITATION,
	'routerad' => NF_ICMPv6_TYPE_ROUTERADVERTISEMENT,
	'timex' => NF_ICMPv6_TYPE_TIMEEXCEED,
#	'squench' => ,
#	'redir' => ,
#	'paramprob' => ,
#	'timest' => ,
#	'timestrep' => ,
#	'inforeq' => ,
#	'inforep' => ,
#	'maskreq' => ,
#	'maskrep' => ,
#	'' => NF_ICMPv6_CODE_NOROUTE,
#	'' => NF_ICMPv6_CODE_ADMINPROHIBITED,
#	'' => NF_ICMPv6_CODE_NOTASSIGNED,
#	'' => NF_ICMPv6_CODE_ADDRESSUNREACH,
#	'' => NF_ICMPv6_CODE_PORTUNREACH,
#	'' => NF_ICMPv6_CODE_HOPLIMITEXCEED,
#	'' => NF_ICMPv6_CODE_FRAGREASSEMBLYEXCEEDED,
#	'' => NF_ICMPv6_CODE_ERRONEOUSHERDERFIELD,
#	'' => NF_ICMPv6_CODE_UNKNOWNNEXTHEADER,
#	'' => NF_ICMPv6_CODE_UNKNOWNOPTION,
);

my %icmp_codes = (
	'zero' => NF_ICMPv6_CODE_ZERO,
#	'' => NF_ICMPv6_TYPE_TOOBIG,
#	'' => NF_ICMPv6_TYPE_PARAMETERPROBLEM,
#	'' => NF_ICMPv6_TYPE_NEIGHBORSOLICITATION,
#	'' => NF_ICMPv6_TYPE_NEIGHBORADVERTISEMENT,
);

my %tcp_flags = (
	'F' => NF_TCP_FLAGS_FIN,
	'S' => NF_TCP_FLAGS_SYN,
	'R' => NF_TCP_FLAGS_RST,
	'P' => NF_TCP_FLAGS_PSH,
	'A' => NF_TCP_FLAGS_ACK,
	'U' => NF_TCP_FLAGS_URG,
	'E' => NF_TCP_FLAGS_ECE,
	'C' => NF_TCP_FLAGS_CWR,
);

while (defined(my $line = <STDIN>)) {
	chomp $line;
	# Skip comments
	next if $line =~ m/^#/;
	# Skip emty lines
	next if $line =~ m/^\s*$/;
	# Optional (unused) action
	my $action;
	if ($line =~ m/\G\s*(pass|block)\b/g) {
		$action = $1;
	}
	# Optional direction and interface
	my ($dir, $if);
	if ($line =~ m/\G\s*(in|out)\s*(on)?\s*(\w+)\b/g) {
		$dir = $1; $if = $3;
	}
	# Protocol
	my $proto;
	if ($line =~ m/\G\s*(udp|tcp|icmp)\b/g) {
		$proto = $1;
	} else {
		die "$line: unknown protocol\n";
	}
	# ICMP type/code
	my ($icmp_type, $icmp_code);
	if ($proto eq "icmp") {
		if ($line =~ m/\G\s*(\w+)(,(\w+))?\b/g) {
			if (looks_like_number($1)) {
				$icmp_type = $1;
			} elsif (defined($icmp_types{$1})) {
				$icmp_type = $icmp_types{$1};
			} else {
				die "unknown icmp type $1\n";
			}
			if (!defined($3)) {
				$icmp_code = 0;
			} elsif (looks_like_number($3)) {
				$icmp_code = $3;
			} elsif (defined($icmp_codes{$3})) {
				$icmp_code = $icmp_codes{$3};
			} else {
				die "unknown icmp code $3\n";
			}
		} else {
			die "$line: missing icmp type\n";
		}
	}
	# Source address/port
	my ($src_addr, $src_port);
	if ($line =~ m/\G\s*([^\s,]*)(,(\w+))?\b/g) {
		$src_addr = $1;
		if (!defined $3) {
			# undef $src_port;
		} elsif (looks_like_number($3)) {
			$src_port = $3;
		} else {
			$src_port = scalar getservbyname($3, $proto);
			die "unknown service $3\n" unless $src_port;
		}
	} else {
		die "$line: invalid source\n";
	}
	# Optional arrow
	$line =~ m/\G\s*(-?>)?/gc;
	# Destination address/port
	my ($dst_addr, $dst_port);
	if ($line =~ m/\G\s*([^\s,]*)(,(\w+))?\b/g) {
		$dst_addr = $1;
		if (!defined $3) {
			# undef $dst_port;
		} elsif (looks_like_number($3)) {
			$dst_port = $3;
		} else {
			$dst_port = scalar getservbyname($3, $proto);
			die "unknown service $3\n" unless $dst_port;
		}
	} else {
		die "$line: invalid destination\n";
	}
	# Optional TCP flags
	my $tcp_flags = 0;
	if ($proto eq "tcp") {
		$line =~ m/\G\s*/gc;
		while ($line =~ m/\G(.)/gc) {
			if (defined $tcp_flags{$1}) {
				$tcp_flags |= $tcp_flags{$1};
			} else {
				die "unknown TCP flag $1\n";
			}
		}
	}
	# Check for extra garbage
	$line =~ m/\G\s*/gc;
	die "extra garbage at end of line: $1\n" if $line =~ m/\G(.+)$/gc;
	# Build packet
	my $next_header;
	my ($icmp, $udp, $tcp);
	my $echo;
	if ($proto eq "icmp") {
		die "ICMP with source port\n" if $src_port;
		die "ICMP with destination port\n" if $dst_port;
		$next_header = NF_IPv6_PROTOCOL_ICMPv6;
		$icmp = Net::Frame::Layer::ICMPv6->new(
			type => $icmp_type,
			code => $icmp_code,
			checksum => 0,
			payload => "",
		);
		# Hack: add a Net::Frame::Layer::ICMPv6::Echo object
		$echo = Net::Frame::Layer::ICMPv6::Echo->new(
			payload => "",
		);
	} elsif ($proto eq "udp") {
		die "UDP without source port\n" unless $src_port;
		die "UDP without destination port\n" unless $dst_port;
		$next_header = NF_IPv6_PROTOCOL_UDP;
		$udp = Net::Frame::Layer::UDP->new(
			src => $src_port,
			dst => $dst_port,
			payload => "",
		);
	} elsif ($proto eq "tcp") {
		die "TCP without source port\n" unless $src_port;
		die "TCP without destination port\n" unless $dst_port;
		$next_header = NF_IPv6_PROTOCOL_TCP;
		$tcp = Net::Frame::Layer::TCP->new(
			src => $src_port,
			dst => $dst_port,
			flags => $tcp_flags,
			payload => "",
		);
	} else {
		die "oops: proto $proto\n";
	}
	my $ip = Net::Frame::Layer::IPv6->new(
		src => $src_addr,
		dst => $dst_addr,
		nextHeader => $next_header,
	);
	my $frame;
	$frame = Net::Frame::Simple->new(layers => [ $ip, $icmp, $echo ]) if $icmp;
	$frame = Net::Frame::Simple->new(layers => [ $ip, $udp ]) if $udp;
	$frame = Net::Frame::Simple->new(layers => [ $ip, $tcp ]) if $tcp;
	die "oops: no frame\n" unless $frame;
	$frame->pack();
	# print $frame->print(), "\n";
	# Output
	my $dump = $frame->dump();
	print "[$dir,$if]\n" if $dir;
	print join " ", $dump =~ m/../g;
	print "\n\n";
}