# $Revision: 1.16 $
#--------------------------------------------------------------------
#
#	ProcessC98Blocks.pl
#
#		This script analyzes Chaocipher pt and ct as per
#		Jeff Hill's C98 hypothesis.
#
#	Written by: Moshe Rubin (April 2009)
#
#--------------------------------------------------------------------

use strict;
use diagnostics;  
use warnings;

# <variables>
my $ptfile = "";
my $ctfile = "";
my $blocksize_from = 0;
my $blocksize_to = 0;
my $pt = "";
my $ct = "";
my $printmatches = 0;
my $printsummary = 0;

parseCommandLine();
validateCommandLine();
displayOptions();

#
ReadFiles ();
Process ();

print "\nFinished!\n";

#--------------------------------------------------------------------
# Subroutines
#--------------------------------------------------------------------

sub usage
{
	print "\n";
	print "Usage: perl ProcessC98Blocks.pl -pt <plaintext file>\n";
	print "                                -ct <ciphertext file>\n";
	print "                                -blocksize-from <number>\n";
	print "                                -blocksize-to <number>\n";
	print "                                [-printmatches]\n";
	print "                                [-printsummary]\n";
	print "\n";
}

sub parseCommandLine
{
	my $i;
	my $p;
	
	# Parse command line
	for ($i=0; $i<@ARGV; $i++)
	{
		# Convert parameter to lowercase for comparison
		$p = lc($ARGV[$i]);

    # NOTE: Compare $p with LOWERCASE strings only!
    		
		if ($p eq "-pt")
		{
			$ptfile = $ARGV[++$i];
		}
		elsif ($p eq "-ct")
		{
			$ctfile = $ARGV[++$i];
		}
		elsif ($p eq "-blocksize-from")
		{
			$blocksize_from = int($ARGV[++$i]);
		}
		elsif ($p eq "-blocksize-to")
		{
			$blocksize_to = int($ARGV[++$i]);
		}
		elsif ($p eq "-printmatches")
		{
			$printmatches = 1;
		}
		elsif ($p eq "-printsummary")
		{
			$printsummary = 1;
		}
		elsif	(
					($p eq "-?")
					||
					($p eq "--?")
					||
					($p eq "/?")
					||
					($p eq "-h")
					||
					($p eq "--h")
					||
					($p eq "-help")
					||
					($p eq "--help")
				)
		{
			usage();
			exit;
		}
		else
		{
			print ("\nError: Unexpected command line parameter ($ARGV[$i]), aborting\n");
			usage();
			exit();
		}
	}
}

sub validateCommandLine
{
	if (!(-e $ptfile))
	{
		print ("\nError: The pt file \"$ptfile\" does not exist\n");
		usage();
		exit();
	}

	if (!(-e $ctfile))
	{
		print ("\nError: The ct file \"$ctfile\" does not exist\n");
		usage();
		exit();
	}

	if ($blocksize_from < 0)
	{
		print ("\nError: The block size FROM value ($blocksize_from) is invalid\n");
		usage();
		exit();
	}

	if ($blocksize_to < 0)
	{
		print ("\nError: The block size TO value ($blocksize_to) is invalid\n");
		usage();
		exit();
	}

	if ($blocksize_from > $blocksize_to)
	{
		print ("\nError: The block size TO value ($blocksize_to) must be >= than the block size FROM value ($blocksize_from)\n");
		usage();
		exit();
	}
}

sub displayOptions
{
	printf "\n";
	printf "Session options\n";
	printf "===============\n";
	printf "\tPlaintext file:         $ptfile\n";
	printf "\tCiphertext file:        $ctfile\n";
	printf "\tBlock size (from):      $blocksize_from\n";
	printf "\tBlock size (to):        $blocksize_to\n";
	printf "\tPrint Matches:          %s\n", $printmatches ? "true" : "false";
	printf "\tPrint Summary:          %s\n", $printsummary ? "true" : "false";
	printf "\n";
}

sub ReadFiles
{
	open (PT, "<$ptfile");
	$pt = <PT>;
	close (PT);

	open (CT, "<$ctfile");
	$ct = <CT>;
	close (CT);

	if (length($pt) != length($ct))
	{
		print ("\nError: The pt and ct files have different lengths (%d vs. %d)\n", length($pt), length($ct));
		usage();
		exit();
	}
}

sub Process
{
	my $i;
	my $line = 0;
	
	for ($i=$blocksize_from; $i<=$blocksize_to; ++$i)
	{
		ProcessBlocksize ($i);
	}
}

sub ProcessBlocksize
{
	my ($blocksize) = @_;
	my $i;
	my $line = 0;
	my $total_contradictions_in_block = 0;
	my $total_found_contradictions = 0;
	my $contains_multiple_contradictions = 0;

	if ($printmatches != 0)
	{
		printf "\n";
		printf "+----------------------------------------------------------\n";
		printf "| Blocksize $blocksize\n";
		printf "+----------------------------------------------------------\n";
	}
	
	for ($i=0; $i<length($pt); $i += $blocksize)
	{
		my $ptBlock;
		my $ctBlock;
		my $j;
		my %track;
		
		++$line;
		if ($printmatches != 0)
		{
			print "\n";
			print "\n";
			print "Processing line $line\n";
			print "\n";
			
			printf "\t    Occurrence          CT Letters\n";
			printf "\t    ----------          ----------\n";
			printf "\tPT   1st  2nd  Distance  1st  2nd\n";
			printf "\t--  ---------- -------- ----------\n";
		}
		
		$ptBlock = substr ($pt, $i, $blocksize);
		$ctBlock = substr ($ct, $i, $blocksize);
		
		# Iterate through $ptBlock, find all identical pt letters within
		# distance of 1-6.
			
		$total_contradictions_in_block = 0;
		
		for ($j=0; $j<$blocksize-1; ++$j)
		{
			my $k;
			
			for ($k=1; $k<=6; ++$k)
			{
				my $key;
				
				if (($j + $k) >= length($ptBlock))
				{
					# The second pt letter extends past the end of the block
					last;
				}
				
				my $p1 = substr ($ptBlock, $j, 1);
				my $p2 = substr ($ptBlock, $j+$k, 1);
				my $contradiction = 0;
				
				if	(
						($p1 ne $p2)
						||
						($p1 eq "?")
						||
						($p2 eq "?")
					)
				{
					next;
				}
				
				my $c1 = substr ($ctBlock, $j, 1);
				my $c2 = substr ($ctBlock, $j+$k, 1);
				my @contradictions;
				my $contradiction_description = "";

				# Identical pt letters, check validity, output information
				$key = "$c1$c2";
				
				if (defined($track{$key}))
				{
					$track{$key} .= ":$k";
				}
				else
				{
					$track{$key} .= "$k";
				}
				
				@contradictions = CheckForContradictions ($key, \%track);
				if ($contradictions[0] == 1)
				{
					$contradiction_description .= " $c1--(1)-->$c2 and $c1--(5/6)-->$c2";
					++$total_contradictions_in_block;
				}

				if ($contradictions[1] == 1)
				{
					$contradiction_description .= " $c1--(?)-->$c2 and $c2--(?)-->$c1";
					++$total_contradictions_in_block;
				}
				
				if (length($contradiction_description) > 0)
				{
					$contradiction_description = "CONTRADICTION:" . $contradiction_description;
				}

				if ($printmatches != 0)
				{
					printf "\t%s    %2d   %2d       %d      %s    %s    %s\n", 
						   $p1, 
						   $j+1, 
						   $j+$k+1, 
						   $k, 
						   substr ($ctBlock, $j, 1), 
						   substr ($ctBlock, $j+$k, 1),
						   $contradiction_description;
				}
			}
		}
		
		if ($printmatches != 0)
		{
			if ($total_contradictions_in_block > 1)
			{
				printf "\tMultiple contradictions encountered in block\n";
			}
		}
		
		$total_found_contradictions += $total_contradictions_in_block;
		if ($total_contradictions_in_block > 1)
		{
			++$contains_multiple_contradictions;
		}
	}
	
	if ($printsummary)
	{
		my $total = "";
		my $multiple = "";
		
		if ($total_found_contradictions > 0)
		{
			$total = sprintf "(%3d found)", $total_found_contradictions;
		}
		
		if ($contains_multiple_contradictions > 0)
		{
			$multiple = sprintf "(%d case(s) of multiple contradictions)", $contains_multiple_contradictions;
		}
		
		printf "Blocksize %3d: %s %s %s\n", $blocksize, $total_found_contradictions > 0 ? "CONTRADICTION" : "", $total, $multiple;
	}
}

sub CheckForContradictions
{
	my ($key, $track) = @_;
	my $cont_1 = 0;
	my $cont_2 = 0;
	my $s = $track->{$key};
	
	$cont_1 = CheckForContradiction_1 ($s);
	$cont_2 = CheckForContradiction_2 ($key, $track);
	
	return ($cont_1, $cont_2);
}

sub CheckForContradiction_1
{
	# Two x-->y ranges must overlap, otherwise it's a contradiction
	
	my ($s) = @_;
	my @v;
	
	@v = split /:/, $s;
	
	if	(
			arrayHasValue(1, @v)
			&&
			(
				arrayHasValue(5, @v)
				||
				arrayHasValue(6, @v)
			)
		)
	{
		return 1;
	}
	else
	{
		return 0;
	}
}

sub arrayHasValue
{
	my ($val, @v) = @_;
	my $i;
	
	for ($i=0; $i<scalar(@v); ++$i)
	{
		if ($v[$i] == $val)
		{
			return 1;
		}
	}
	
	return 0;
}


sub CheckForContradiction_2
{
	# Check x-->y and y-->x for contradictions
	
	my ($key, $track) = @_;
	my $rev_key = reverse ($key);
	my $s;
	my $t;
	my @v_s;
	my @v_t;

	if	(
			!defined ($track->{$key})
			||
			!defined ($track->{$rev_key})
		)
	{
		return 0;
	}
	
	$s = $track->{$key};
	$t = $track->{$rev_key};
	@v_s = split /:/, $s;
	@v_t = split /:/, $t;

	if	(
			(
				arrayHasValue(1, @v_s)
				&&
				!arrayHasValue(6, @v_t)
			)
			||
			(
				arrayHasValue(2, @v_s)
				&&
				!arrayHasValue(5, @v_t)
				&&
				!arrayHasValue(6, @v_t)
			)
			||
			(
				arrayHasValue(3, @v_s)
				&&
				!arrayHasValue(4, @v_t)
				&&
				!arrayHasValue(5, @v_t)
				&&
				!arrayHasValue(6, @v_t)
			)
			||
			(
				arrayHasValue(4, @v_s)
				&&
				!arrayHasValue(4, @v_t)
				&&
				!arrayHasValue(5, @v_t)
				&&
				!arrayHasValue(6, @v_t)
			)
			||
			(
				arrayHasValue(5, @v_s)
				&&
				!arrayHasValue(3, @v_t)
				&&
				!arrayHasValue(4, @v_t)
				&&
				!arrayHasValue(5, @v_t)
				&&
				!arrayHasValue(6, @v_t)
			)
			||
			(
				arrayHasValue(6, @v_s)
				&&
				!arrayHasValue(2, @v_t)
				&&
				!arrayHasValue(3, @v_t)
				&&
				!arrayHasValue(4, @v_t)
				&&
				!arrayHasValue(5, @v_t)
				&&
				!arrayHasValue(6, @v_t)
			)
		)
	{
		return 1;
	}

	return 0;
}