#!perl -w

=begin PerlDox

package Crypt::RS14_PP;
our $VERSION = '0.02';

=head1 SYNOPSIS

    use Crypt::RS14_PP;

    my $key   = '16 to 64 bytes of key';
    my $rs14  = Crypt::RS14_PP->new($key);
    my $ctext = $rs14->encrypt('This is my plain text.');
    $rs14->set_key($key);
    my $ptext = $rs14->encrypt($ctext); # or decrypt as both do the same
    print "$ptext\n"; # prints 'This is my plain text.'

I<Note:> Only the encrypt/decrypt capabilities of RS14 are implemented.

I<Note:> In this module, encrypt/decrypt use bitwise exclusive-or (C<^>) to
encipher/decipher the input, as this is commonly used in stream ciphers.
As a consequence, encrypt and decrypt are the same. Other operations are
possible. This not specified in the algorithm specification.

I<Note:> To encrypt "wide characters", such as Unicode, the character stream
B<must> be encoded into a byte stream before encrypting. (For Unicode, use
UTF-8 encoding.) Whatever encoding is used, security is enhanced by excluding
any byte order marks.

=cut

use warnings;
use strict;

# only load Carp if needed
sub _carp
{
    require Carp;
    Carp::carp(@_);
}
sub _croak
{
    require Carp;
    Carp::croak(@_);
}

# Tried C<use integer;> but causes bitwise ops to treat numbers as signed (see Perl documentation)

use constant {
    N   => 256,   #< Number of elements in S-Box.
                  #  @note This implementation is byte oriented, so N == 256
                  #  @note This implementation assumes N is a power of 2. If not,
                  #  update of w will need enhancement to ensure gcd(N,w) == 1,
                  #  i.e., N and w must be relatively prime.
};

use constant {
    A   => N + 0, #< index of a (number of nibbles absorbed) in instance array
    I   => N + 1, #< index of i (an internal state index) in instance array
    J   => N + 2, #< index of j (an internal state index) in instance array
    K   => N + 3, #< index of k (an internal state index) in instance array
    W   => N + 4, #< index of w (an internal state index) in instance array
    Z   => N + 5, #< index of z (output state index) in instance array
    M   => N - 1, #< mask for modulo-N operations
};

## Creates a RS14 object and optionally sets the cryptographic key.
sub new
{
    my ($class,
        $key    #< @param - Key (optional - used for compatability with other Crypt:: modules)
        ) = @_;
    my $self = bless [];
    $self->set_key($key) if defined $key;
    return $self;
}

## Sets the cryptographic key.
sub set_key
{
    my ($S,
        $key   #< @param - Key - 16 to N/4 bytes of key
        ) = @_;
    if (defined $key)
    {
        _carp('key too short') if (length($key) < 16);
        _croak('key too long') if (length($key) > (N / 4));
        my @bytes = unpack('C*', $key);
        $S->_init(); # only initialize if key is going to be used
        $S->_absorb($key);
        $S->_shuffle();
    }
}

## Encrypt (or decrypt) the given data bytes. (This function is
#  identical to C<decrypt>.)
#  @note Because this is a stream cipher, C<encrypt("ab") eq encrypt("a") . encrypt("b")>.
#        To encrypt (or decrypt) 2 messages with same key, you must C<set_key($key)>
#        before each message. Also, to encrypt and decrypt with same key, you must
#        C<set_key($key)> between encrypting and decrypting (or use 2 objects).
sub encrypt
{
    my $S = $_[0];
    my @bytes = unpack('C*', $_[1]);            #< @param $string Byte string to encrypt or decrypt

    @bytes = map { ($_ ^ $S->_cipher()) } @bytes;
    return pack('C*', @bytes);
}

## Decrypt (or encrypt) the given data bytes. (This function is
#  identical to C<encrypt>.)
sub decrypt
{
    ## @par See L</encrypt>.
    goto &encrypt;
}

## Update the S-Box state. Update the state with values that
#  are a complex function of the current values.
sub _update
{
    my $S = $_[0];
    my ($i, $j, $k, $w) = \@$S[I .. W];
    $$i = ($$i + $$w) & M;
    $$j = ($$k + $$S[($$j + $$S[$$i]) & M]) & M;
    $$k = ($$i + $$k + $$S[$$j]) & M;
    @$S[$$j, $$i] = @$S[$$i, $$j];
}

## Produce next byte of the cipher stream. The output is a
#  complex function of the state and itself. This is a form
#  of OFB mode (Output Feedback).
sub _cipher
{
    my $S = $_[0];
    $S->_update();
    my ($i, $j, $k, $w, $z) = \@$S[I .. Z];
    $$z = ($$S[($$j + $$S[($$i + $$S[($$z + $$k) & M] & M)]) & M]) & M;
}

## Thoroughly mix the S-Box. Repeatedly call _update to provide
#  very complex new values to the state.
sub _whip
{
    my $S = $_[0];
    $S->_update() for (0 .. ((N * 2) - 1));
    $$S[W] += 2; ## @note If N not a power of 2, a complex update is
                 #        required to keep w relatively prime to N
}

## More mixing - this step is irreversible. It intentionally looses
#  information about the current state. Specifically, it maps 2**(N/2)
#  states to 1. This makes it harder to reverse engineer the key.
sub _crush
{
    my $S = $_[0];
    for my $v (0 .. (int(N / 2) - 1))
    {
        if ($$S[$v] > $$S[(N - 1) - $v])
        {
            @$S[$v, (N - 1) - $v] = @$S[(N - 1) - $v, $v];
        }
    }
}

## The mix master
sub _shuffle
{
    $_[0]->_whip();
    $_[0]->_crush();
    $_[0]->_whip();
    $_[0]->_crush();
    $_[0]->_whip();
    $_[0]->[A] = 0;
}

## Bring in key data
#  @note Byte oriented implementation
#  @note Assumes key limited to N/2 nibbles (N/4 bytes). Otherwise
#        must check if a >= (N/2) to trigger a _shuffle.
sub _absorb
{
    my $S = $_[0];
    my $a = \$$S[A];
    for (split '', $_[1]) #< @param $string Key string (bytes) to absorb
    {
        my $t = ord($_);
        for my $x ((0x0f & $t), ((0xf0 & $t) >> 4))
        {
            # (see note) $S->_shuffle() if ($$a >= int(N / 2));
            @$S[int(N / 2) + $x, $$a] = @$S[$$a, int(N / 2) + $x];
            $$a++;
        }
    }
}

## Initialize the S-Box and state variables
sub _init
{
    my $S = $_[0];
                 # a  i  j  k  w  z
    @$S[A .. Z] = (0, 0, 0, 0, 1, 0);
    $$S[$_] = $_ for (0 .. (N - 1));
}

1;