Gecko [ edgpens.lpkmn.gov.my ]

Name	Size	Permission	Action
Base.pm	4.42 KB	-rw-rw-rw-

Code Editor : 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).

${this.title}

Code Editor : Base.pm