#!/usr/bin/perl -w

# rc4twister.pl - Cryptosystem build upon the Mersenne Twister 
# (See README for details).
# 
# Copyright (c) 2003 
# Chris Grier, Jeff Kramer, Madhur Nigam, Mike Perry and Andy Washington. 

# This program is released WITHOUT WARRANTY under the GPL. 
# See http://www.gnu.org/copyleft/gpl.html for details

# Note: there are known issues with this code and perl 5.8.. Use perl 5.6 :)

my $DO_PERMUTATION = 1;

# /* Period parameters */  
my $STATE_SIZE = 624;
my $M = 397;
my $UPPER_MASK = 0x80000000; # /* most significant w-r bits */
my $LOWER_MASK = 0x7fffffff; # /* least significant r bits */

#/* Tempering parameters */   
my $TEMPERING_MASK_B = 0x9d2c5680;
my $TEMPERING_MASK_C = 0xefc60000;

my @state;
my @results;
my @matrixA = (0, 0x9908b0df);

my $rc4i;
my $rc4j; # RC4-like permutation variables

sub TEMPERING_SHIFT_U
{
    return ($_[0] >> 11);
}

sub TEMPERING_SHIFT_S
{
    return ($_[0] << 7);
}

sub TEMPERING_SHIFT_T
{
    return ($_[0] << 15);
}

sub TEMPERING_SHIFT_L
{
    return ($_[0] >> 18);
}

sub temper
{
    my $y = $_[0];

    $y ^= TEMPERING_SHIFT_U($y);
    $y ^= TEMPERING_SHIFT_S($y) & $TEMPERING_MASK_B;
    $y ^= TEMPERING_SHIFT_T($y) & $TEMPERING_MASK_C;
    $y ^= TEMPERING_SHIFT_L($y);

    return $y; 
}

sub state_init
{
    my $initializer = $_[0];
    
    $state[0]= $initializer;
    for(my $i = 1; $i < $STATE_SIZE; $i++)
    {
        # /* See Knuth TAOCP Vol2. 3rd Ed. P.106 for multiplier. */
        # /* In the previous versions, MSBs of the seed affect   */
        # /* only MSBs of the array mt[].                        */
        $state[$i] = 
            (((1812433253 * ($state[$i - 1] ^ ($state[$i - 1] >> 30)))
             % 0xffffffff) + $i) % 0xffffffff;
    }
}

sub set_key
{
    my $permute = shift(@_);
    my @key = @_;
    my $i = 1;
    my $j = 0;
    my $k;
    
    state_init(19650218);
    
    # Guard against weak keys in the permutation step 
    for($k = 0; $k < scalar(@key); $k++)
    {
        if($key[$k] % $STATE_SIZE == 0)
        {
            $key[$k]++;
        }
    }

    $k = ($STATE_SIZE > scalar(@key) ? $STATE_SIZE : scalar(@key));

    for(; $k; $k--)
    {
        $state[$i] = (($state[$i] ^ ((($state[$i - 1] 
                        ^ ($state[$i - 1] >> 30)) * 1664525) % 0xffffffff))
                        + $key[$j] + $j) % 0xffffffff;
        $i++; 
        $j = ($j + 1) % scalar(@key);

        if($i >= $STATE_SIZE) 
        { 
            $state[0] = $state[$STATE_SIZE - 1]; $i = 1; 
        }
    }

    for($k = $STATE_SIZE - 1; $k > 0; $k--)
    {
        $state[$i] = ($state[$i] ^ ((($state[$i-1] ^ ($state[$i-1] >> 30))
                    * 1566083941) % 0xffffffff)) - $i; 
        $i++;
        if ($i>=$STATE_SIZE) 
        { 
            $state[0] = $state[$STATE_SIZE-1]; 
            $i = 1; 
        }
    }

    # Do a permutation on this result to conceal the dependence of 
    # state on key
    if($permute == 1)
    {

        for($j = $i = 0; $i < $STATE_SIZE; $i++)
        {
            $j = ($j + 
                    $state[$i] % $STATE_SIZE + 
                    ($key[$j % scalar(@key)]/(($i^$j) % 4 + 1)*$STATE_SIZE) % $STATE_SIZE)
                % $STATE_SIZE;

            $state[$i] ^= $state[$j];
            $state[$j] ^= $state[$i];
            $state[$i] ^= $state[$j];
        }
    }

    # Set the rc4-like indices
    $rc4i = $rc4j = 0;

    for($i = 1; $i < 5; $i++)
    {
        $rc4i = ($rc4i + $key[$rc4j % scalar(@key)]/($i*$STATE_SIZE)) % $STATE_SIZE;
        $rc4j = ($rc4j ^ $rc4i ^ $state[$rc4i]);
    }

    $rc4j = $rc4j % $STATE_SIZE;

    splice(@results, 0, scalar(@results));

    # After suffle: MSB is 1, assuring non-zero initial array 
    $state[0] = 0x80000000;
}

sub mrand
{
    my $ret;
 
    if(scalar(@results) == 0)
    {
        my $k;
        my $exchanger;

        for($k = 0; $k < $STATE_SIZE - $M; $k++)
        {
            $exchanger = ($state[$k] & $UPPER_MASK) | 
                ($state[$k+1] & $LOWER_MASK);
            $state[$k] = $state[$k+$M] ^ 
                ($exchanger >> 1) ^ $matrixA[$exchanger & 1]; 
        }

        for(; $k < $STATE_SIZE - 1; $k++)
        {
            $exchanger = ($state[$k] & $UPPER_MASK) | 
                ($state[$k+1] & $LOWER_MASK);
            $state[$k] = $state[$k + $M - $STATE_SIZE] 
                ^ ($exchanger >> 1) ^ $matrixA[$exchanger & 1];
        }

        $exchanger = ($state[$k] & $UPPER_MASK) | ($state[0] & $LOWER_MASK);
        $state[$k] = $state[$M - 1] ^ ($exchanger >> 1) ^ 
            $matrixA[$exchanger & 1];
    
        # copy the state over for permuted return
        @results = @state;
    }

    # Guard against weak states
    if($rc4j == ($rc4i + 1) && $state[$rc4i+1] == 1)
    {
        $rc4i = $rc4j + 1;
    }

    $rc4i = ($rc4i + 1) % $STATE_SIZE;
    $rc4j = ($rc4j + $state[$rc4i]) % $STATE_SIZE;

    $state[$rc4j] ^= $state[$rc4i];
    $state[$rc4i] ^= $state[$rc4j];
    $state[$rc4j] ^= $state[$rc4i];
    
    my $z = ($state[$rc4j] + $state[$rc4i]) % scalar(@results);

    $ret = $results[$z];

    splice(@results, $z, 1);
 
    return temper($ret);
}

sub real_encrypt
{
    my $intarray = $_[0];
    my $key1 = $_[1];
    my $key2 = $_[2];
    my @cryptarray;
    my $i;

    set_key(1, $key1, $key2);
    for($i = 0; $i < scalar(@{$intarray}); $i++)
    {
        $cryptarray[$i] = ${$intarray}[$i] ^ mrand();
    }

    return \@cryptarray;
}


sub read_file($)
{    
    my @wordarray;
    my %wordtable;
    my $plaintext = "";

    #This code takes a filename passed to it, opens the file, and 
    #hashes the words inside, then returns it.

    if (length(@_) > 0) { $plain = join(' ', $_[0]); }
        else { die "No data specified."; }

    open (PLAINTEXT,"<$plain") || die "Can't open $plain $!";

    while () {
        $plaintext = $plaintext . $_;
        my @splitted = split(/\W/);
        push @wordarray, @splitted;
        last if (eof);
    }
    close PLAINTEXT;

    foreach(@wordarray)
    {
        if(!(ord($_) eq 0))
        {
            if (exists $wordtable{$_}) {
                $wordtable{$_}++;
            } else {
                $wordtable{$_} = 1;
            }
        }
    }

    return ($plaintext, %wordtable);
}

sub find_replace
{
    #we want to modify the hash given to us
    #and return the found and replaced string 

    my ($text, $wordlist) = @_;

    # basically calculating the word weight to replace
    foreach my $word (keys %{$wordlist})
    {
        ${$wordlist}{$word} = length($word) * ${$wordlist}{$word};
    }
    
    # now sort based on the weight
    my @keys = sort { ${$wordlist}{$a} cmp ${$wordlist}{$b} } keys %{$wordlist};
  
    # clear out the hash
    foreach $key (@keys)
    {
        delete ${$wordlist}{$key};
    }
   
    # assign the words values greater than ascii characters
    # basically from 128-256
    my $base;
    for($base = 128; $base < 256 && ($base-128) < scalar(@keys); $base++)
    {
        ${$wordlist}{$keys[$base-128]} = chr($base);
    }
    
    
    splice(@keys, $base - 128, scalar(@keys) - ($base - 128));
   
    # do the find and replace step
    foreach (@keys)
    {
        $text =~ s/($_){1}/${$wordlist}{$_}/g;
    }

    return $text;
}

# function to decompress, takes a wordlist with the numbers as Keys, and 
# the words as values
sub replace_find
{
    my ($text, $wordlist) = @_;
    
    foreach my $key (keys %{$wordlist})
    {
        $text =~ s/(${$wordlist}{$key}){1}/$key/g;
    }
    return $text;
}

sub bit_shuffle 
{
    my ($list) = @_;
    my $first4_1;
    my $first4_2;
    my $first4_3;
    my $first4_4;
    my $first4_5;
    my $first4_6;
    my $first4_7;
    my $first4_8;
    
    my $first4_2new;
    my $first4_4new;
    my $first4_6new;
    my $first4_8new;
    
    my $test;
    my @new_list;
    $total = 0;

    foreach my $item (@{$list})
    {
        $first4_1 = $item & 0xf0000000;
        $first4_2 = $item & 0x0f000000;
        $first4_2new = $first4_2 << 4;
        
        $first4_3 = $item & 0x00f00000;
        $first4_4 = $item & 0x000f0000;
        $first4_4new = $first4_4 << 4;
        $first4_5 = $item & 0x0000f000;
        $first4_6 = $item & 0x00000f00;
        $first4_6new = $first4_6 << 4;
        $first4_7 = $item & 0x000000f0;
        $first4_8 = $item & 0x0000000f;
        
        $first4_8new = $first4_8 << 4;
        
        $new_list[$total] = ($first4_1 ^ $first4_2new)|($first4_2)|($first4_3 ^ $first4_4new)|($first4_4)|($first4_5 ^ $first4_6new)|($first4_6)| ($first4_7 ^ $first4_8new)|($first4_8);
        $total++;
    }
    return \@new_list;
}

sub chars_to_int($)
{
    my @chararray = split(//,$_[0]);
    my $clen = scalar(@chararray);
    my @integerlist = ();
    my $i=0;

    # pad to zero
    my $remainder = scalar(@chararray) % 4;
    
    for($i = 0; $i < $remainder; $i++)
    {
        $chararray[$clen + $i] = chr(0);
    }

    for($i = 0; $i + 4 <= scalar(@chararray); $i += 4)
    {
        $integerlist[$i/4] = 
            ord($chararray[$i + 2]) +
            (ord($chararray[$i + 3]) << 8) +
            (ord($chararray[$i + 0]) << 16) +
            (ord($chararray[$i + 1]) << 24);
    }

    

    return \@integerlist;
}

sub int_to_chars
{
    my $intarray = $_[0];
    my @chararray;
    my $i=0;
    
    for($i = 0; $i < scalar(@{$intarray}); $i++)
    {
        $chararray[$i*4 + 0] = chr((${$intarray}[$i] & 0x00ff0000) >> 16);
        $chararray[$i*4 + 1] = chr((${$intarray}[$i] & 0xff000000) >> 24);
        $chararray[$i*4 + 2] = chr(${$intarray}[$i] & 0x000000ff);
        $chararray[$i*4 + 3] = chr((${$intarray}[$i] & 0x0000ff00) >> 8);
    }

    return join("", @chararray);
}

sub store_wordlist
{
    my $cbuffer = $_[0];
    my $wordlist = $_[1];

    my $wbuffer = pack('L!', length($cbuffer)) . $cbuffer;
    
    my @keys = keys(%{$wordlist});

    my @values;

    foreach $key (@keys)
    {
        push(@values, ${$wordlist}{$key});
    }
    
    my $wordlist_len = scalar(@keys);

    my $avalues = join("", @values);
  
    $wbuffer = $wbuffer . pack("L!", $wordlist_len);
    $wbuffer = $wbuffer . pack("a*", $avalues);

    foreach (@keys)
    {
        $wbuffer = $wbuffer . pack("Z*" , $_);
    }
    
    return $wbuffer;
}

sub retr_wordlist
{
    my $buffer = $_[0];
    my %wordlist;

    my $buflen = unpack('L!', $buffer);

    #FIXME: will this work?
    my $ret_buffer = substr($buffer, 4, $buflen);

    my $packed_wordlist = substr($buffer, 4+$buflen, length($buffer)-4-$buflen);
    
    my $numpacked = unpack('L!', $packed_wordlist);

    $packed_wordlist = substr($packed_wordlist, 4, 
            length($packed_wordlist) - 4);
    
    my $avalues = unpack("a*", $packed_wordlist);
    
    $packed_wordlist = substr($packed_wordlist, $numpacked, length($packed_wordlist) - $numpacked);
    
    my @vals = split(//, $avalues);

    for(my $i = 0; $i < $numpacked; $i++)
    {
        my $key = unpack("Z*", $packed_wordlist);
        $wordlist{$key} = $vals[$i];
        $packed_wordlist = substr($packed_wordlist, length($key)+1, 
                length($packed_wordlist) - length($key) - 1);
    }

    return ($ret_buffer, %wordlist);
}

sub main
{
    my $op = $_[0];
    my $file_in = $_[1];
    my $file_out = $_[2];
    my $key1 = $_[3];
    my $key2 = $_[4];

    if($op eq "enc")
    {
        my $buffer;
        ($buffer, %wordlist) = read_file($file_in);
        my $cbuffer = find_replace($buffer, \%wordlist);
        my $wbuffer = store_wordlist($cbuffer, \%wordlist);
        my $intbuffer = chars_to_int($wbuffer);
        my $shbuffer = bit_shuffle($intbuffer);
        my $cryptbuffer = real_encrypt($shbuffer, $key1, $key2);
        my $packed = pack('L!*', @{$cryptbuffer});
        open(OUT_FILE, ">$file_out");
        print OUT_FILE "$packed";
        close OUT_FILE;
    }

    if($op eq "dec")
    {

        my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
         $atime,$mtime,$ctime,$blksize,$blocks)
            = stat($file_in);

        open(IN_FILE, "<$file_in");

        my $packed2;
        read(IN_FILE, $packed2, $size);
        
        my @unpacked = unpack('L!*', $packed2);
        my $intbuffer2 = real_encrypt(\@unpacked, $key1, $key2);
        my $unshuffled = bit_shuffle($intbuffer2);
        my $newbuffer = int_to_chars($unshuffled);
        ($newbuffer, %temphash) = retr_wordlist($newbuffer);
        my $dcbuffer = replace_find($newbuffer, \%temphash);

        open(OUT_FILE, '>', $file_out);
        print OUT_FILE "$dcbuffer";

    }
}

if(@ARGV < 4)
{
    print "Usage: $0 <enc or dec> <input file> <output file> <key integer 1> <key integer 2>\n";
    exit(0);
}

main(@ARGV);

</pre>