File Coverage

blib/lib/Crypt/PBE/PBKDF1.pm

Criterion	Covered	Total	%
statement	78	85	91.7
branch	7	12	58.3
condition	22	44	50.0
subroutine	20	24	83.3
pod	9	10	90.0
total	136	175	77.7

package Crypt::PBE::PBKDF1;

use strict;
use warnings;
use utf8;

use Carp;
use MIME::Base64;
use Digest::MD2 qw(md2);
use Digest::MD5 qw(md5);
use Digest::SHA qw(sha1);
use Exporter qw(import);

our $VERSION = '0.102';

our @EXPORT = qw(
    pbkdf1
    pbkdf1_base64
    pbkdf1_hex
);

our @EXPORT_OK = qw(
    pbkdf1_md2
    pbkdf1_md2_base64
    pbkdf1_md2_hex

    pbkdf1_md5
    pbkdf1_md5_base64
    pbkdf1_md5_hex

    pbkdf1_sha1
    pbkdf1_sha1_base64
    pbkdf1_sha1_hex
);

sub new {

    my ( $class, %params ) = @_;

    my $password = delete $params{password} || croak 'Specify password';
    my $salt     = delete $params{salt}     || croak 'Specify salt';
    my $count    = delete $params{count}    || 1_000;
    my $hash     = delete $params{hash}     || 'sha1';
    my $dk_len   = 20;

    $dk_len = 16 if ( $hash eq 'md5' || $hash eq 'md2' );

    my $self = {
        password => $password,
        salt     => $salt,
        count    => $count,
        hash     => $hash,
        dk_len   => $dk_len
    };

    bless $self, $class;

    return $self;

}

sub hash_algorithm     { shift->{hash} }
sub count              { shift->{count} }
sub derived_key_length { shift->{dk_len} }

sub derived_key {
    my ($self) = @_;
    return pbkdf1(
        password => $self->{password},
        salt     => $self->{salt},
        count    => $self->{count},
        hash     => $self->{hash},
        dk_len   => $self->{dk_len}
    );
}

sub derived_key_base64 {
    my ($self) = @_;
    return pbkdf1_base64(
        password => $self->{password},
        salt     => $self->{salt},
        count    => $self->{count},
        hash     => $self->{hash},
        dk_len   => $self->{dk_len}
    );
}

sub derived_key_hex {
    my ($self) = @_;
    return pbkdf1_hex(
        password => $self->{password},
        salt     => $self->{salt},
        count    => $self->{count},
        hash     => $self->{hash},
        dk_len   => $self->{dk_len}
    );
}

# PBKDF1 (P, S, c, dkLen)
#
#   Options:        Hash       underlying hash function
#
#   Input:          P          password, an octet string
#                   S          salt, an octet string
#                   c          iteration count, a positive integer
#                   dkLen      intended length in octets of derived key,
#                              a positive integer, at most 16 for MD2 or
#                              MD5 and 20 for SHA-1
#   Output:         DK         derived key, a dkLen-octet string

sub pbkdf1 {

    my (%params) = @_;

    my $hash = delete( $params{hash} )     || 'sha1';
    my $P    = delete( $params{password} ) || croak('Specify password');
    my $S    = delete( $params{salt} )     || croak('Specify salt');
    my $c    = delete( $params{count} )    || 1_000;
    my $dkLen = delete( $params{dk_len} );

    if ( $hash ne 'md2' && $hash ne 'md5' && $hash ne 'sha1' ) {
        croak 'unknown hash function';
    }

    if ( !$dkLen ) {
        $dkLen = 16 if ( $hash =~ /md(2|5)/ );
        $dkLen = 20 if ( $hash eq 'sha1' );
    }

    if ( ( $hash eq 'md5' && $dkLen > 16 ) || ( $hash eq 'md2' && $dkLen > 16 ) || ( $hash eq 'sha1' && $dkLen > 20 ) )
    {
        croak 'derived key too long';
    }

    my $T = $P . $S;

    no strict 'refs';    ## no critic

    for ( 1 .. $c ) {
        $T = &{$hash}($T);
    }

    my $DK = substr( $T, 0, $dkLen );

    return $DK;

}

sub pbkdf1_hex {
    return join '', unpack '(H2)*', pbkdf1(@_);
}

sub pbkdf1_base64 {
    return encode_base64 pbkdf1(@_), '';
}

for my $digest (qw/md2 md5 sha1/) {

    my $dk_len = 16;
    $dk_len = 20 if ( $digest eq 'sha1' );

    my $sub_name = 'pbkdf1_' . $digest;

    no strict 'refs';    ## no critic

    *{$sub_name} = sub {
        my (%params) = @_;
        $params{hash}   = $digest;
        $params{dk_len} = $dk_len;
        return pbkdf1(%params);
    };

    *{ $sub_name . '_base64' } = sub {
        my (%params) = @_;
        $params{hash}   = $digest;
        $params{dk_len} = $dk_len;
        return encode_base64 pbkdf1(%params), '';
    };

    *{ $sub_name . '_hex' } = sub {
        my (%params) = @_;
        $params{hash}   = $digest;
        $params{dk_len} = $dk_len;
        return join '', unpack '(H2)*', pbkdf1(%params);
    };

}

1;
__END__