#!/usr/bin/perl
#
# pontifex.cgi
#
# Implement the Solitaire algorithm as outlined in the book Cryptonomicon.
# Original code is by Ian Goldberg 
# Bug fixes and CGI by Jauder Ho 
#
#
# 090899 jauderho [dgaudet mentioned error messages all over the place about]
#		  [uninitialized values in the log. This is due to how the]
#		  [substitution stuff works. $& will always be unintialized]
#		  [for the first pattern. There is no nice workaround and the]
#		  [reason why the -w flag is missing. Feel free to correct me.]
# 020200 jauderho [moved to carumba.org. updated to use HTML::CarumbaOrg]
#

# We need the following because we are using our spiffy HTML::CarumbaOrg
use lib '/home/www/docroot/carumba/carumba.org/perl/';
use HTML::CarumbaOrg;

use CGI qw(:standard);

# Comment out the first 2 "use" lines and uncomment the next 2 for local use
# sub printCarumbaHeader { print header; print start_html; }
# sub printCarumbaFooter { print end_html; }

my $multFactor;
my $deck;
my $key;
my $keyPhrase;
my $count;
my $text;
my $value;
my $intro;

sub printHTML;
sub genKeystream;
sub getValue;

# Introductory text
$intro = "
	  Pontifex is the name used for the Solitaire algorithm devised by
	  Bruce Schneier of
	  <a href=\"http://www.counterpane.com\">Counterpane Systems</a> in
	  Neal Stephenson's novel
	  <a href=\"http://www.cryptonomicon.com\"><i>Cryptonomicon</i></a>.
	  They have a more 
	  <a href=\"http://www.counterpane.com/solitaire.html\">elaborate</a>
	  description available. There was some errors with the original 
	  script presented. 
	  <a href=\"pontifex.txt\">Here</a> 
	  is the cleaned up version in CGI form and it should be trivial to
	  revert to a command line version. There are some limitations:
	  relatively short message length and only letters are encrypted.";

# Encrypt/decrypt text if there is text available to do so.
if (param) {
	# Set up the deck in sorted order.  chr(33) == '!' represents A of
	# clubs, chr(34) == '"' represents 2 of clubs, and so on in order
	# until chr(84) == 'T' represents K of spades.  chr(85) == 'U' is
	# joker A and chr(86) == 'V' is joker B.
	$deck = pack('C*',33..86);

	# Load the key phrase, and turn it all into uppercase.
	$keyPhrase = param('key');
	$keyPhrase =~ y/a-z/A-Z/;

	# For each letter in the key phrase, run the key setup routine (which
	# is the same as the keystream routine, except that $k is set to the
	# value of each successive letter in the key phrase).
	$keyPhrase =~ s/[A-Z]/$key=ord($&)-64,genKeystream/eg;

	# Stop setting up the key and switch to encrypting/decrypting mode.
	# $key = 0; # The code in genKeystream requires that this be changed.
	undef $key;

	# Collect all of the alphabetic characters (in uppercase) from the
	# input	files (or stdin if none specified) into the variable $text.
	$text = param('cryptotext');
	$text =~ y/a-z/A-Z/;	# Change all lowercase to uppercase
	$text =~ y/A-Z//dc;	# Remove any non-letters

	# Set the multiplication factor to -1 if decrypting else set it to 1.
	# This factor will be multiplied by the output of the keystream
	# generator and added to the input (this has the effect of doing
	# addition for encryption, and subtraction for decryption). If we're
	# encrypting, append X to the input until it's a multiple of 5 chars.
	if (param('crypt') eq "Encrypt") {
		$multFactor = 1;
		$text .= "X" while (length($text)%5);
	} else {
		$multFactor = -1;
	}

	# This next line does the crypto:
	# For each character in the input ($&), which is between 'A' and 'Z',
	# find its ASCII value (ord($&)), which is in the range 65..90,
	# subtract 13 (ord($&)-13), to get the range 52..77, add (or subtract
	# if decrypting) the next keystream byte (the output of the function
	# genKeystream) and take the result mod 26
	# ((ord($&)-13+$multFactor*genKeystream)%26), to get the range 0..25,
	# add 65 to get back the range 65..90, and determine the character with
	# that ASCII value (chr((ord($&)-13+$multFactor*genKeystream)%26+65)),
	# which is between 'A' and 'Z'.  Replace the original character with
	# this new one.
	$text =~ s/./chr((ord($&)-13+$multFactor*genKeystream)%26+65)/eg;

	# If we're decrypting, remove trailing X's from the newly found
	# plaintext.
	$text =~ s/X*$// unless ($multFactor == 1);

	# Put a space after each group of 5 characters and print the result.
	$text =~ s/.{5}/$& /g;

	# Insert the output back into the field
	param(-name=>'cryptotext',-value=>$text);
}
	
printHTML;	# Print the results

# The End

# Generate the display code.
sub printHTML {
	printCarumbaHeader("pontifex");
	
	print "<p>",
	      $intro,
	      "<p>",
	      "<font size=\"-1\">",
	      start_form,
	      "<p>",
	      "Key Phrase<br>",
	      textfield(-name=>'key',
			-size=>'40'),
	      "<p>",
	      "Text<br>",
	      textarea(-name=>'cryptotext',
	               -wrap=>'soft',
		       -rows=>'10',
		       -columns=>'40'),
	      "<p>",
	      submit('crypt','Encrypt'), "&nbsp;",
	      submit('crypt','Decrypt'), "&nbsp;",
	      reset,
	      end_form,
	      "</font>";

	printCarumbaFooter;
}

# The following subroutine gives the value of the nth card in the deck. n is
# passed in as an argument to this routine ($_[0]).  The A of clubs has value
# 1, ..., the K of spades has value 52, both jokers have value 53. The top card
# is the 0th card, the bottom card is the 53rd card.
sub getValue {
	# The value of most cards is just the ASCII value minus 32.
	# substr($deck,$_[0]) is a string beginning with the nth card in the
	# deck.
	$value = ord(substr($deck,$_[0]))-32;

	# Special case: both jokers (53 and 54, normally) have value 53, so
	# return 53 if the value is greater than 53, and the value otherwise.
	$value > 53 ? 53 : $value;
}

# The following subroutine generates the next value in the keystream.
sub genKeystream {
	# If the U (joker A) is at the bottom of the deck, move it to the top
	$deck =~ s/(.*)U$/U$1/;

    	# Swap the U (joker A) with the card below it
        $deck =~ s/U(.)/$1U/;

	# Do the same as above, but with the V (joker B), and do it twice.
	$deck =~ s/(.*)V$/V$1/; $deck =~ s/V(.)/$1V/;
	$deck =~ s/(.*)V$/V$1/; $deck =~ s/V(.)/$1V/;

	# Do the triple cut: swap the pieces before the first joker, and after
	# the second joker.
	$deck =~ s/(.*)([UV].*[UV])(.*)/$3$2$1/;

	# Do the count cut: find the value of the bottom card in the deck
	$count = getValue(53);

	# Switch that many cards from the top of the deck with all but the last
	# card.
	$deck =~ s/(.{$count})(.*)(.)/$2$1$3/;

	# If we're doing key setup, do another count cut here, with the count
	# value being the letter value of the key character (A=1, B=2, etc.;
	# this value will already have been stored in $key).  After the second
	# count cut, return, so that we don't happen to do the loop at the
	# bottom.
	if ($key) {
	    $deck =~ s/(.{$key})(.*)(.)/$2$1$3/;
	    return;
	}

	# Find the value of the nth card in the deck, where n is the value
	# of the top card (be careful about off-by-one errors here)
	$count = getValue(getValue(0));

	# If this wasn't a joker, return its value.  If it was a joker,
	# just start again at the top of this subroutine.
	$count > 52 ? genKeystream : $count;
}