#!/usr/bin/perl

#---------------------------------------------------------------
# Playfair Cipher script
# Author: Rick Saunders
# Date:   12 Sept, 2002
#
# This script builds a Playfair tableau from a given key-
# word and then encrypts/decrypts a section of text following
# the rules for the Playfair cipher.

# The Playfair system was invented circa 1854 by Charles
# Wheatstone (of the Wheatstone bridge fame) and named after
# a friend the first Baron Playfair St. Andrews. It was,
# and is, quick, fairly secure and needed only a pencil
# and paper to use. While the general solution for a Playfair
# cipher has been known for some time, the system was used
# extensivly in WWI as a trench code, and by the Australian
# coast watchers in WWII.
#---------------------------------------------------------------

print "Content-type: text/html\n\n";
$alphabet = "ABCDEFGHIKLMNOPQRSTUVWXYZ";

# Get the input text (either plain or ciphertext), get rid of
# any spaces and swap I's for J's
#---------------------------------------------------------------

&FormInput( *input );
$intext = $plaintext = uc( $input{ 'textin' } );
$plaintext =~ s/\r//g;
$plaintext =~ s/\n//g;
$plaintext =~ s/ //g;
$plaintext =~ s/J/I/g;

# Get the keyword/phrase to build the Playfair tableau and
# dump remove any spaces
#---------------------------------------------------------------

$keyword = uc( $input{ 'keyword' } );
$keyword =~ s/ //g;

# Get the mode.... 1 = 'encrypt' and 0 = 'decrypt'
#---------------------------------------------------------------

$mode = $input{ 'mode' };

# If we're in 'encrypt' mode, we have to do some massaging
# of the input text. So let's do all that now.
#---------------------------------------------------------------

if ( $mode ) {
	$ptlen = length( $plaintext );

# Create a 'prepared text'. This has pairs of identical letters
# split with an 'X' and a random letter added to the end should
# the text be of an odd length. We need to do this in order to
# create an even length string which can be split into pairs.

# First pad the string with a random letter if needed.
#---------------------------------------------------------------

	srand();
	$randletter = chr( 65 + rand( 26 ) );
	if ( length( $preptext ) % 2 == 1 ) {
		$preptext .= $randletter;
	}

# Now check the input text for double letters and split them with
# an X  or Q as needed. The Q is only used if we are splitting
# double X's (not common I'd assume).
#---------------------------------------------------------------

	$preptext = substr( $plaintext, 0, 1 );
	for $a ( 1..$ptlen - 1 ) {
		$l1 = substr( $plaintext, $a, 1 );
		$l2 = substr( $plaintext, $a-1, 1 );
		if ( $l1 ne $l2 ) {
			$preptext .= substr( $plaintext, $a, 1 );
		} else {
			if ( substr( $plaintext, $a, 1 ) eq "X" ) {
				$preptext .= "Q" . substr( $plaintext, $a, 1 );
			} else {
				$preptext .= "X" . substr( $plaintext, $a, 1 );
			}
		}
	}

# For decrypt... we don't want to mess with the input text other
# than to remove spaces.
#---------------------------------------------------------------

} else {
	$preptext = $plaintext;
	$preptext =~ s/ //g;
}

# Now we create the Playfair tableau. This is a five by five
# letter grid. We use 'I' and 'J' and as the same. We'll
# start by putting the keyword (with no letter letter
# replacements into the start of the string which we'll
# use to create the matrix. Once we've put the keyword
# into the tableau we'll do the rest of the alphabet.
#---------------------------------------------------------------

$alphalist = "";
$keyword =~ s/J/I/g;

for $a ( 0..length( $keyword ) - 1 ){
	$thisletter = substr( $keyword, $a, 1 );
	if ( $alphalist !~ /$thisletter/ ) {
		$alphalist .= $thisletter;
	}
}
for $a ( 0..length( $alphabet ) - 1 ){
	$thisletter = substr( $alphabet, $a, 1 );	
	if ( $alphalist !~ /$thisletter/ ) {
		$alphalist .= $thisletter;
	}
}

# Split the string into five arrays which equate to the five
# rows of the tableau.
#---------------------------------------------------------------


for $x ( 0..4 ) {
	for $y ( 0..4 ) {
		push( @{ "row" . $x }, substr( $alphalist, $x * 5 + $y, 1 ) );
	}
}

# Now we do the Playfair transposition. This works as follows:
# If two letters of a pair are on the same row, then replace
# them with the two letters to their right.

# If the two letters are in the same column, replace them
# with the letters in the tableau to their right. If they
# are neither, then the ciphertext letter for the first
# in a pair will be the letter on the same row as the plaintext
# but in the column of the second letter... and vice versa.
# Simple eh?

#---------------------------------------------------------------

while ( $a < length( $preptext ) ) {
	$l1 = substr( $preptext, $a, 1 );
	$l2 = substr( $preptext, $a + 1, 1 );
	for $c ( 0..4 ) {
		for $b ( 0..$#{ "row" . $c } ) {
			if ( ${ "row" . $c }[$b] eq $l1 ) {
				$rowa = $c;
				$cola = $b;
			}
			if ( ${ "row" .  $c }[$b] eq $l2 ) {
				$rowb = $c;
				$colb = $b;
			}
		}
	}
	$offset = $mode ? 1 : -1;
	if ( $rowa == $rowb ) {
		$ciphera = ${ "row" . $rowa }[ ( $cola + $offset ) % 5 ];
		$cipherb = ${ "row" . $rowb }[ ( $colb + $offset ) % 5 ];
	} elsif ( $cola == $colb ) {
		$ciphera = ${ "row" . ( $rowa + $offset ) % 5 }[ $cola ];
		$cipherb = ${ "row" . ( $rowb + $offset ) % 5 }[ $colb ];
	} else {	
		$ciphera = ${ "row" . $rowb }[$cola];
		$cipherb = ${ "row" . $rowa }[$colb];
	}
	$string .= $ciphera . $cipherb;
	$a += 2;
}	


# Print the output
#---------------------------------------------------------------

print qq|
	<html>
	<head><title>The Playfair Cipher</title></head>
	<body bgcolor=#ccddcc>
	<center>
	<font color=#107310 size=+2><b>Ozzzy's Place</b></font><br>
	<font color=#107310 size=+1><b>The Playfair Cipher</b></font>
	</center>
	<hr align=left>
	<br>
	<center>
	<b><font color=red>The Playfair Tableau Created</font></b><br><br>
	<table width=200 border=1 align=center bgcolor=white>
|;

# Print the tableau for us.
#---------------------------------------------------------------
	
for $d ( 0..4 ) {
	print "<tr>";
	for $e ( 0..$#{ "row" . $d } ) {
		$tabout = ${ "row" . $d }[$e];
		if ( $tabout eq "I" ) {
			$tabout = "IJ";
		}
		print "<td width=40 align=center><b>$tabout</b></td>";
	}
	print "</tr>";
}
print "</table>";
print "<br><br>";
print "<table width=500 border=0 align=center><tr><td align=left>";

$header1 = $mode ? "Plaintext" : "Ciphertext";
print "<b><font color=#107310>$header1</font></b><br>";
print "<pre>";
if ( $mode ) {
	$count = 0;
	for $f ( 0..length( $intext ) -1 ) {
		$thisletter = substr( $intext, $f, 1 );
		if ( ( $count > 50 ) && ( $thisletter eq " " ) ) {
			print "<br>";
			$count = 0;
		} else {
			print $thisletter;
			$count++;
		}
	}
	print "<br>";
} else {

# If the ciphertext has spaces, let's assume that it's in
# 5-letter groups. If it has no spaces, let's put it in
# 5-letter groups.
#---------------------------------------------------------------

	if ( $intext !~ / / ) {
		$count = 1;
		for $f ( 0..length( $intext ) -1 ) {
			$thisletter = substr( $intext, $f, 1 );
			if ( $count == 50 ) {
				print $thisletter . "<br>";
				$count = 1;
			} elsif ( ( $count % 5 == 0 ) && ( $count != 0 ) ) {
				print $thisletter . " ";
				$count++;
			} else {
				print $thisletter;
				$count++;
			}
		}
		print "<br>";
	} else {
		$count = 0;
		for $f ( 0..length( $intext ) -1 ) {
			$thisletter = substr( $intext, $f, 1 );
			if ( $count == 58 )  {
				print $thisletter . "<br>";
				$count = 0;
			} else {
				print $thisletter;
				$count++;
			}
		}
		print "<br>";
	}
}
print "</pre>";
print "<br>";

$header2 = $mode ? "Ciphertext" : "Plaintext";
print "<b><font color=#107310>$header2</font></b><br>";
print "<pre>";

# This is the output of a decrypt which would be plaintext. As
# the original plaintext has no spaces, this will not either.
# We'll chop the ouput at 51 characters, just to keep it
# almost readable.
#---------------------------------------------------------------

if ( ! $mode ) {
	$count = 0;
	for $f ( 0..length( $string ) - 1 ) {
		$thisletter = substr( $string, $f, 1 );
		if ( $count == 50 ) {
			print $thisletter . "<br>";
			$count = 0;
		} else {
			print $thisletter;
			$count++;
		}
	}

# This will be the output for an encrypt, which is cipher text.
# Let's split it into 5 letter groups just for clarity and
# ease of copying. As we dropped J's in the input text we'll
# put them back now by randomly changing every I we come across
# or not.
#---------------------------------------------------------------

} else {
	$count = 1;
	for $f ( 0..length( $string ) - 1 ) {
		$thisletter = substr( $string, $f, 1 );
		if ( $thisletter eq "I" ) {
			$switch = int( rand( 100 ) );
			if ( $switch % 2 == 0 ) {
				$thisletter = "J";
			}
		}
		if ( $count == 50 ) {
			print $thisletter . "<br>";
			$count = 1;
		} elsif ( ( $count % 5 == 0 ) && ( $count != 0 ) ) {
			print $thisletter . " ";
			$count++;
		} else {
			print $thisletter;
			$count++;
		}
	}
}
print "<br>";
print "</pre>";
print qq|
	</td></tr></table>
	<center>
	<hr align=center width=450>
	<a href=/playfair.txt>Have a look at the script</a><br><br>
	<font color=#107310 size=-1><i>Copyright &copy; 2002, Rick Saunders<br>
	</font></i>
	</center>
	</body>
	</html>
|;

#The subroutine that parses out the html form
#---------------------------------------------------------------------
sub FormInput
{
	local (*qs) = @_ if @_;
	read(STDIN,$qstring,$ENV{'CONTENT_LENGTH'});
	@qs = split(/&/,$qstring);
	foreach $i ( 0 .. $#qs ) {
		$qs[$i] =~ s/\+/ /g;
		$qs[$i] =~ s/%(..)/pack("c",hex($1))/ge;

		($name, $value) = split(/=/,$qs[$i],2);
	
		if($qs{$name} ne "")
		{
			$qs{$name} = "$qs{$name}:$value";	
		}
		else
		{
			$qs{$name} = $value;
		}
	}
return 1;
}