#!/usr/bin/perl -w

use strict;

## Nicias cryptosystem
## David Roundy <droundy@physics.berkeley.edu> Jul 16, 2000
## Some noncrypto portions taken from sol.pl by 
##       Ian Goldberg <ian@cypherpunks.ca>

## Make sure we have at least the key phrase argument
die "Usage: $0 [-d] 'key phrase' [infile ...]\n" unless $#ARGV >= 0;

## Do we want to decrypt?
my $do_decrypt = 0;
if ($ARGV[0] eq '-d') {
    shift @ARGV;
    $do_decrypt = 1;
}

## Set up the deck in sorted order.
##
## Cards are stored as charactgers.  Black cards are lowercase,
## white cards are uppercase.
my $key = 'aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ';

## Load the key phrase, and turn it all into lowercase
my $keyphrase = shift; 
$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).
while ($keyphrase) {
    my ($this_char) = $keyphrase =~ /^(.)/;
    $keyphrase =~ s/^(.)//;
    shuffle(\$key, $this_char);
}

## Stop setting up the key and switch to encrypting/decrypting mode.

## Collect all of the alphabetic characters (in uppercase) from the input
## files (or stdin if none specified) into the variable $input_string
my $input_string = '';
my $output_string = '';
while(<>) {
    ## Change all lowercase to uppercase
    y/A-Z/a-z/;
    ## Remove any non-letters
    y/a-z//dc;
    ## Append the input to $input_string
    $input_string .= $_;
}

## If we're encrypting, append X to the input until it's a multiple of 5 chars
if (!$do_decrypt) {
    $input_string.='x' while length($input_string)%5;
}

## This next line does the crypto.
while ($input_string) {
    my ($this_char) = $input_string =~ /^(.)/;
    my $plain = $this_char;
    $input_string =~ s/^(.)//;
    if ($do_decrypt) {
        $plain = lookup_plain_from_cipher(\$key, $this_char);
        $output_string.= $plain;
        $plain =~ tr/A-Z/a-z/;
    } else {
        $output_string.= lookup_cipher_from_plain(\$key, $this_char);
    }
    shuffle(\$key, $plain);
}
## If we're decrypting, remove trailing X's from the newly found plaintext
$output_string =~ s/X*$// if $do_decrypt;

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

## The main program ends here.  The following are subroutines.

sub transpose3x17 {
    my $key = $_[0];
    my $stack1='';
    my $stack2='';
    my $stack3='';
    my $i;
    for ($i=0;$i<17;$i++) {
        $stack1 = $stack1 . chop($$key);
        $stack2 = $stack2 . chop($$key);
        $stack3 = $stack3 . chop($$key);
    }
    $$key = $$key . $stack1 . $stack2 . $stack3;
    return;
}

sub transpose5x7 {
    my $key = $_[0];
    my $stack1='';
    my $stack2='';
    my $stack3='';
    my $stack4='';
    my $stack5='';
    my $i;
    for ($i=0;$i<7;$i++) {
        $stack1 = $stack1 . chop($$key);
        $stack2 = $stack2 . chop($$key);
        $stack3 = $stack3 . chop($$key);
        $stack4 = $stack4 . chop($$key);
        $stack5 = $stack5 . chop($$key);
    }
    $$key = $$key . $stack1 . $stack2 . $stack3 . $stack4 . $stack5;
    return;
}

sub cutswapblack {
    my ($key, $oncard) = @_;
    $$key =~ s/(.)(.*)$oncard(.*)/$1$3$oncard$2/;
    return;
}

sub cutswapblackbottom {
    my ($key) = @_;
    my ($oncard) = $$key =~ /^(.)/;
    $oncard =~ tr/a-mn-z/n-za-m/;
    $$key =~ s/(.)(.*)$oncard(.*)/$1$3$oncard$2/;
    return;
}

sub cutswapred {
    my ($key, $oncard) = @_;
    $$key =~ s/(.*)$oncard(.*)(.)/$2$oncard$1$3/;
    return;
}

sub swapbottom {
    my ($key, $oncard) = @_;
    my ($withcard) = $$key =~ /^(.)/;
    $withcard =~ tr/a-mn-z/n-za-m/;
    if ($$key =~ /$oncard(.+)$withcard/) {
        $$key =~ s/$oncard(.+)$withcard/$withcard$1$oncard/;
    } else {
        $$key =~ s/$withcard(.+)$oncard/$oncard$1$withcard/;
    }
    return;
}

sub swap {
    my ($key, $oncard, $withcard) = @_;
    if ($$key =~ /$oncard(.+)$withcard/) {
        $$key =~ s/$oncard(.+)$withcard/$withcard$1$oncard/;
    } else {
        $$key =~ s/$withcard(.+)$oncard/$oncard$1$withcard/;
    }
    return;
}

sub sliggle {
    my ($key) = @_;
    $$key =~ s/^(.)(.)(.)/$3$2$1/;
    return;
}

sub shuffle {
    my ($key, $plain) = @_;
    my $redplain = $plain;
    $redplain =~ tr/a-z/A-Z/;
    cutswapblack($key, $plain);
    swapbottom($key, $plain);
    cutswapred($key, $redplain);
    transpose3x17($key);
    cutswapblackbottom($key);
    transpose5x7($key);
    sliggle($key);
}

sub lookup_cipher_from_plain {
    my($key, $input) = @_;
    my $temp;
    ($temp) = $$key =~ /$input(.)/;
 #   print "$$key -- $input -> $temp\n";
    return $temp;
}

sub lookup_plain_from_cipher {
    my($key, $input) = @_;
    my $temp;
    $input =~ tr/a-z/A-Z/;
    ($temp) = $$key =~ /(.)$input/;
 #   print "$$key -- $input -> $temp\n";
    $temp =~ tr/a-z/A-Z/;
    return $temp;
}