File Coverage

blib/lib/Crypt/HCE_SHA.pm

Criterion	Covered	Total	%
statement	71	73	97.2
branch	6	8	75.0
condition	7	9	77.7
subroutine	11	11	100.0
pod	0	5	0.0
total	95	106	89.6

#
# Crypt::HCE_SHA
# implements one way hash chaining encryption using SHA
#
# $Id: HCE_SHA.pm,v 1.3 2000/02/19 03:47:11 eric Exp $
#

package Crypt::HCE_SHA;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

use Digest::SHA;
use MIME::Base64;
use Carp;

require Exporter;
require AutoLoader;

@ISA = qw(Exporter AutoLoader);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(

);
$VERSION = '0.75';


sub new {
    my $class = shift;
    my $self = {};

    bless $self, $class;

    if ((@_ != 2) && (@_ != 3)) {
        croak "Error: must be invoked HCE_SHA->new(key, random_thing, [algorithm to use (1, 224, 256, 384, 512)])";
    }

    $self->{SKEY} = shift(@_);
    $self->{RKEY} = shift(@_);
    if (@_ > 0) {
        $self->{BITS} = shift(@_);
    } else {
        $self->{BITS} = 1;
   }

    return $self;
}

sub _new_key {
    my $self = shift;
    my ($rnd) = @_;

    my $context = new Digest::SHA->new($self->{BITS});
    $context->add($self->{SKEY}, $rnd);
    my $digest = $context->digest();
    my @e_block = unpack('C*', $digest);
    return @e_block;
}

sub hce_block_encrypt {
    my $self = shift;
    my ($data) = @_;
    my ($i, $key, $data_size, $ans, $mod, @e_block, @data, @key, @ans);

    @key = unpack ('C*', $self->{SKEY});
    @data = unpack ('C*', $data);

    undef @ans;
    @e_block = $self->_new_key($self->{RKEY});
    $data_size = scalar(@data);
    for($i=0; $i < $data_size; $i++) {
        $mod = $i % 20;
        if (($mod == 0) && ($i > 19)) {
            @e_block = $self->_new_key(pack 'C*', (@ans)[($i-20)..($i-1)]);
        }
        $ans[$i] = $e_block[$mod] ^ $data[$i];
    }
    $ans = pack 'C*', @ans;
    return $ans;
}

sub hce_block_decrypt {
    my $self = shift;
    my ($data) = @_;
    my ($i, $key, $data_size, $ans, $mod, @e_block, @data, @key, @ans);

    @key = unpack ('C*', $self->{SKEY});
    @data = unpack ('C*', $data);

    undef @ans;
    @e_block = $self->_new_key($self->{RKEY});
    $data_size = scalar(@data);
    for($i=0; $i < $data_size; $i++) {
        $mod = $i % 20;
        if (($mod == 0) && ($i > 19)) {
            @e_block = $self->_new_key(pack 'C*', (@data)[($i-20)..($i-1)]);
        }
        $ans[$i] = $e_block[$mod] ^ $data[$i];
    }
    $ans = pack 'C*', @ans;
    return $ans;
}

sub hce_block_encode_mime {
    my $self = shift;
    my ($data) = @_;

    my $new_data = $self->hce_block_encrypt($data);
    my $encode = encode_base64($new_data, "");
    return $encode;
}

sub hce_block_decode_mime {
    my $self = shift;
    my ($data) = @_;

    my $decode = decode_base64($data);
    my $new_data = $self->hce_block_decrypt($decode);
    return $new_data;
}

# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__