File Coverage

blib/lib/PBKDF2/Tiny.pm

Criterion	Covered	Total	%
statement	51	51	100.0
branch	8	14	57.1
condition	3	8	37.5
subroutine	11	11	100.0
pod	6	6	100.0
total	79	90	87.7

use strict;
use warnings;

package PBKDF2::Tiny;
# ABSTRACT: Minimalist PBKDF2 (RFC 2898) with HMAC-SHA1 or HMAC-SHA2

our $VERSION = '0.003';

use Carp ();
use Exporter 5.57 qw/import/;

our @EXPORT_OK = qw/derive derive_hex verify verify_hex hmac digest_fcn/;

my ( $BACKEND, $LOAD_ERR );
for my $mod (qw/Digest::SHA Digest::SHA::PurePerl/) {
    $BACKEND = $mod, last if eval "require $mod; 1";
    $LOAD_ERR ||= $@;
}
die $LOAD_ERR if !$BACKEND;

#--------------------------------------------------------------------------#
# constants and lookup tables
#--------------------------------------------------------------------------#

# function coderef placeholder, block size in bytes, digest size in bytes
my %DIGEST_TYPES = (
    'SHA-1'   => [ undef, 64,  20 ],
    'SHA-224' => [ undef, 64,  28 ],
    'SHA-256' => [ undef, 64,  32 ],
    'SHA-384' => [ undef, 128, 48 ],
    'SHA-512' => [ undef, 128, 64 ],
);

for my $type ( keys %DIGEST_TYPES ) {
    no strict 'refs';
    ( my $name = lc $type ) =~ s{-}{};
    $DIGEST_TYPES{$type}[0] = \&{"$BACKEND\::$name"};
}

my %INT = map { $_ => pack( "N", $_ ) } 1 .. 16;

#--------------------------------------------------------------------------#
# public functions
#--------------------------------------------------------------------------#

#pod =func derive
#pod
#pod     $dk = derive( $type, $password, $salt, $iterations, $dk_length )
#pod
#pod The C function outputs a binary string with the derived key.
#pod The first argument indicates the digest function to use.  It must be one
#pod of: SHA-1, SHA-224, SHA-256, SHA-384, or SHA-512.
#pod
#pod If a password or salt are not provided, they default to the empty string, so
#pod don't do that!  L
#pod recommends|https://tools.ietf.org/html/rfc2898#section-4.1> a random salt of at
#pod least 8 octets.  If you need a cryptographically strong salt, consider
#pod L.
#pod
#pod The number of iterations defaults to 1000 if not provided.  If the derived
#pod key length is not provided, it defaults to the output size of the digest
#pod function.
#pod
#pod =cut

sub derive {
    my ( $type, $passwd, $salt, $iterations, $dk_length ) = @_;

    my ( $digester, $block_size, $digest_length ) = digest_fcn($type);

    $passwd = '' unless defined $passwd;
    $salt   = '' unless defined $salt;
    $iterations ||= 1000;
    $dk_length  ||= $digest_length;

    my $key = ( length($passwd) > $block_size ) ? $digester->($passwd) : $passwd;
    my $passes = int( $dk_length / $digest_length );
    $passes++ if $dk_length % $digest_length; # need part of an extra pass

    my $dk = "";
    for my $i ( 1 .. $passes ) {
        $INT{$i} ||= pack( "N", $i );
        my $digest = my $result =
          "" . hmac( $salt . $INT{$i}, $key, $digester, $block_size );
        for my $iter ( 2 .. $iterations ) {
            $digest = hmac( $digest, $key, $digester, $block_size );
            $result ^= $digest;
        }
        $dk .= $result;
    }

    return substr( $dk, 0, $dk_length );
}

#pod =func derive_hex
#pod
#pod Works just like L but outputs a hex string.
#pod
#pod =cut

sub derive_hex { unpack( "H*", &derive ) }

#pod =func verify
#pod
#pod     $bool = verify( $dk, $type, $password, $salt, $iterations, $dk_length );
#pod
#pod The C function checks that a given derived key (in binary form) matches
#pod the password and other parameters provided using a constant-time comparison
#pod function.
#pod
#pod The first parameter is the derived key to check.  The remaining parameters
#pod are the same as for L.
#pod
#pod =cut

sub verify {
    my ( $dk1, $type, $password, $salt, $iterations, $dk_length ) = @_;

    my $dk2 = derive( $type, $password, $salt, $iterations, $dk_length );

    # shortcut if input dk is the wrong length entirely; this is not
    # constant time, but this doesn't really give much away as
    # the keys are of different types anyway

    return unless length($dk1) == length($dk2);

    # if lengths match, do constant time comparison to avoid timing attacks
    my $match = 1;
    for my $offset ( 0 .. $dk_length ) {
        $match &= ( substr( $dk1, $offset, 1 ) eq substr( $dk2, $offset, 1 ) ) ? 1 : 0;
    }

    return $match;
}

#pod =func verify_hex
#pod
#pod Works just like L but the derived key must be a hex string (without a
#pod leading "0x").
#pod
#pod =cut

sub verify_hex {
    my $dk = pack( "H*", shift );
    return verify( $dk, @_ );
}

#pod =func digest_fcn
#pod
#pod     ($fcn, $block_size, $digest_length) = digest_fcn('SHA-1');
#pod     $digest = $fcn->($data);
#pod
#pod This function is used internally by PBKDF2::Tiny, but made available in case
#pod it's useful to someone.
#pod
#pod Given one of the valid digest types, it returns a function reference that
#pod digests a string of data. It also returns block size and digest length for that
#pod digest type.
#pod
#pod =cut

sub digest_fcn {
    my ($type) = @_;

    Carp::croak("Digest function '$type' not supported")
      unless exists $DIGEST_TYPES{$type};

    return @{ $DIGEST_TYPES{$type} };
}

#pod =func hmac
#pod
#pod     $key = $digest_fcn->($key) if length($key) > $block_sizes;
#pod     $hmac = hmac( $data, $key, $digest_fcn, $block_size );
#pod
#pod This function is used internally by PBKDF2::Tiny, but made available in case
#pod it's useful to someone.
#pod
#pod The first two arguments are the data and key inputs to the HMAC function.
#pod B: if the key is longer than the digest block size, it must be
#pod preprocessed using the digesting function.
#pod
#pod The third and fourth arguments must be a digesting code reference (from
#pod L) and block size.
#pod
#pod =cut

# hmac function adapted from Digest::HMAC by Graham Barr and Gisle Aas.
# Compared to that implementation, this *requires* a preprocessed
# key and block size, which makes iterative hmac slightly more efficient.
sub hmac {
    my ( $data, $key, $digest_func, $block_size ) = @_;

    my $k_ipad = $key ^ ( chr(0x36) x $block_size );
    my $k_opad = $key ^ ( chr(0x5c) x $block_size );

    &$digest_func( $k_opad, &$digest_func( $k_ipad, $data ) );
}

1;


# vim: ts=4 sts=4 sw=4 et:

__END__