File: C:/strawberry/perl/vendor/lib/Digest/OMAC/Base.pm
package Digest::OMAC::Base;
use strict;
#use warnings;
use Carp;
use MIME::Base64;
use constant DEBUG => 0;
use constant UNPACK_CAN_GROUP => $] >= 5.008;
sub new {
my ( $class, $key, $cipher, @args ) = @_;
if ( ref $key ) {
$cipher = $key;
$key = undef;
}
$cipher ||= 'Crypt::Rijndael';
my $self = bless {
cipher => undef,
}, $class;
return $self->_init($key, $cipher, @args);
}
sub add {
my ( $self, @msg ) = @_;
my $msg = join('', grep { defined } $self->{saved_block}, @msg);
$self->{ix} += length($msg);
my $c = $self->{cipher};
my $blocksize = $c->blocksize;
my @blocks = UNPACK_CAN_GROUP
? unpack("(a$blocksize)*", $msg)
: ( $msg =~ /(.{1,$blocksize})/sg );
return unless @blocks;
if ( length($blocks[-1]) < $blocksize ) {
$self->{saved_block} = pop @blocks;
} else {
$self->{saved_block} = '';
}
return unless @blocks;
my $Y = $self->{Y}; # Y[i-1]
my $unenc_y;
foreach my $block ( @blocks ) {
$unenc_y = $block ^ $Y;
$Y = $c->encrypt( $unenc_y ); # Y[i] = E( M[1] xor Y[-1] )
}
$self->{unenc_Y} = $unenc_y;
$self->{Y} = $Y;
return;
}
sub digest {
my $self = shift;
my $c = $self->{cipher};
my $blocksize = $c->blocksize;
my $last_block = $self->{saved_block};
my $X;
if ( length($last_block) or !$self->{ix} ) {
my $padded = pack("B*", substr( unpack("B*", $last_block) . "1" . ( '0' x ($blocksize * 8) ), 0, $blocksize * 8 ) );
$X = $padded ^ $self->{Y} ^ $self->{Lu2};
} else {
$X = $self->{unenc_Y} ^ $self->{Lu};
}
$self->reset;
return $c->encrypt( $X );
}
sub reset {
my $self = shift;
my $blocksize = $self->{cipher}->blocksize;
$self->{Y} = "\x00" x $blocksize;
$self->{saved_block} = '';
return $self;
}
sub _init {
my ( $self, $key, $cipher ) = @_;
if ( ref $cipher ) {
$self->{cipher} = $cipher;
} else {
eval "require $cipher; 1;"
or croak "Couldn't load $cipher: $@";
$self->{cipher} = $cipher->new($key);
}
$self->{saved_block} = '';
my $c = $self->{cipher};
my $blocksize = $c->blocksize;
my $zero = "\x00" x $blocksize;
$self->{Y} = $zero;
my $L = $self->{cipher}->encrypt($zero);
if (DEBUG) { printf STDERR qq{DEBUG >> L=%s\n}, unpack "H*", $L }
$self->{Lu} = $self->_lu( $blocksize, $L );
if (DEBUG) { printf STDERR qq{DEBUG >> Lu=%s\n}, unpack "H*", $self->{Lu}; }
$self->{Lu2} = $self->_lu2( $blocksize, $L, $self->{Lu} ); # for OMAC2 this is actually Lu^-1, not Lu^2, but we still call it Lu2
if (DEBUG) { printf STDERR qq{DEBUG >> Lu2=%s\n}, unpack "H*", $self->{Lu2}; }
return $self;
}
sub _lu {
my ( $self, $blocksize, $L ) = @_;
$self->_shift_lu( $L, $self->_lu_constant($blocksize) );
}
sub _shift_lu {
my ( $self, $L, $constant ) = @_;
# used to do Bit::Vector's shift_left but that's broken
my ( $msb, $tail ) = unpack("a a*", unpack("B*",$L));
my $Lt = pack("B*", $tail . "0");
if ( $msb ) {
return $Lt ^ $constant;
} else {
return $Lt;
}
}
sub _lu_constant {
my ( $self, $blocksize ) = @_;
if ( $blocksize == 16 ) { # 128
return ( ("\x00" x 15) . "\x87" );
} elsif ( $blocksize == 8 ) { # 64
return ( ("\x00" x 7 ) . "\x1b" );
} else {
die "Blocksize $blocksize is not supported by OMAC";
}
}
sub _lu2 {
die "lu2 needs to be defined by subclass";
}
# support methods
sub hexdigest {
return unpack 'H*', $_[0]->digest;
}
sub b64digest {
my $result = MIME::Base64::encode($_[0]->digest);
$result =~ s/=+$//;
return $result;
}
sub addfile {
my $self = shift;
my $handle = shift;
my $n;
my $buff = '';
while (($n = read $handle, $buff, 4*1024)) {
$self->add($buff);
}
unless (defined $n) {
croak "read failed: $!";
}
return $self;
}
sub add_bits {
my $self = shift;
my $bits;
my $nbits;
if (scalar @_ == 1) {
my $arg = shift;
$bits = pack 'B*', $arg;
$nbits = length $arg;
}
else {
$bits = shift;
$nbits = shift;
}
if (($nbits % 8) != 0) {
croak 'Number of bits must be multiple of 8 for this algorithm';
}
return $self->add(substr $bits, 0, $nbits/8);
}
1;
__END__
=head1 NAME
Digest::OMAC::Base - The One-key CBC MAC message authentication code (base
class for OMAC hashes)
=head1 SYNOPSIS
use base qw(Digest::OMAC::Base);
=head1 DESCRIPTION
This module is used internally by L<Digest::CMAC>/L<Digest::OMAC1> and
L<Digest::OMAC2> (which does different shifting than OMAC1 but is otherwise the
same).