File Coverage

blib/lib/Crypt/ScryptKDF.pm

Criterion	Covered	Total	%
statement	71	90	78.8
branch	37	68	54.4
condition	24	53	45.2
subroutine	13	13	100.0
pod	6	6	100.0
total	151	230	65.6

package Crypt::ScryptKDF;

use strict;
use warnings ;

our $VERSION = '0.011';

use MIME::Base64 qw(decode_base64 encode_base64);
use Exporter 'import';
our %EXPORT_TAGS = ( all => [qw(scrypt_raw scrypt_hex scrypt_b64 scrypt_hash scrypt_hash_verify random_bytes)] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw();

require XSLoader;
XSLoader::load('Crypt::ScryptKDF', $VERSION);

sub random_bytes {
  my $length = shift || 32;
  my $rv;

  if (eval {require Crypt::PRNG}) {
    $rv = Crypt::PRNG::random_bytes($length);
  }
  elsif (eval {require Crypt::OpenSSL::Random}) {
    if (Crypt::OpenSSL::Random::random_status()) {
      $rv = Crypt::OpenSSL::Random::random_bytes($length);
    }
  }
  elsif (eval {require Net::SSLeay}) {
    if (Net::SSLeay::RAND_status() == 1) {
      if (Net::SSLeay::RAND_bytes($rv, $length) != 1) {
        $rv = undef;
      }
    }
  }
  elsif (eval {require Crypt::Random}) {
    $rv = Crypt::Random::makerandom_octet(Length=>$length);
  }
  elsif (eval {require Bytes::Random::Secure}) {
    $rv = Bytes::Random::Secure::random_bytes(32);
  }

  if (!defined $rv)  {
    die "FATAL: Cannot generate random bytes. Install one of: Crypt::PRNG, Crypt::OpenSSL::Random, Net::SSLeay, Crypt::Random, or Bytes::Random::Secure\n";
  }

  return $rv
}

sub scrypt_raw {
  warn "scrypt_raw: 2 or 6 parameters required\n" and return undef unless @_ == 2 || @_ == 6;
  my $key = _scrypt_extra(@_);
  return $key;
}

sub scrypt_b64 {
  warn "scrypt_b64: 2 or 6 parameters required\n" and return undef unless @_ == 2 || @_ == 6;
  my $key = _scrypt_extra(@_);
  return undef unless defined $key;
  return encode_base64($key, '');
}

sub scrypt_hex {
  warn "scrypt_hex: 2 or 6 parameters required\n" and return undef unless @_ == 2 || @_ == 6;
  my $key = _scrypt_extra(@_);
  return undef unless defined $key;
  return unpack("H*", $key);
}

sub scrypt_hash {
  my ($key, $salt, $N, $r, $p) = _scrypt_extra(@_);
  return undef unless defined $key && defined $salt && defined $N && defined $r && defined $p;
  return "SCRYPT:$N:$r:$p:" . MIME::Base64::encode($salt, "") . ":" . MIME::Base64::encode($key, "");
}

sub scrypt_hash_verify {
  my ($passwd, $string) = @_;
  return 0 unless $string;
  return 0 unless defined $passwd;
  my ($alg, $N, $r, $p, $salt, $hash) = ($string =~ /^(SCRYPT):(\d+):(\d+):(\d+):([^\:]+):([^\:]+)$/);
  return 0 unless defined $salt && defined $hash;
  $salt = MIME::Base64::decode($salt);
  $hash = MIME::Base64::decode($hash);
  return 0 unless defined $salt && defined $hash;
  return 0 unless length($hash) > 0;
  return 0 unless $N > 0 && $r >= 0 && $p >= 0;
  #XXX-TODO utf8::encode($passwd) if utf8::is_utf8($passwd);
  my $key = _scrypt($passwd, $salt, $N, $r, $p, length($hash));
  return 0 unless defined $key;
  return 0 unless _slow_eq($key, $hash);
  return 1;
}

sub _get_scrypt_defaults {
  # (N=2^14, r=8, p=1, len=32)
  return (16384, 8, 1, 32);
}

sub _scrypt_extra {
  my $salt;
  my @args;
  if (@_ == 1) {        # ... ($passwd)
    ($salt, @args) = (random_bytes(32), _get_scrypt_defaults);
  }
  elsif (@_ == 2) {     # ... ($passwd, $salt)
    ($salt, @args) = ($_[1], _get_scrypt_defaults);
  }
  elsif (@_ == 5) {     # ... ($passwd, $N, $r, $p, $dklen)
    ($salt, @args) = (random_bytes(32), $_[1], $_[2], $_[3], $_[4]);
  }
  elsif (@_ == 6) {     # ... ($passwd, $salt, $N, $r, $p, $dklen)
    (undef, $salt, @args) = @_;
  }
  else {
    warn "ERROR: scrypt() invalid number of arguments\n";
    return;
  }
  #check @args
  my $N = $args[0];
  if ( ($N <= 0) || (($N&($N-1)) != 0) ) { warn "ERROR: invalid 'N'\n"; return }
  if ($args[1] < 1)  { warn "ERROR: invalid 'r'\n"; return }
  if ($args[2] < 1)  { warn "ERROR: invalid 'p'\n"; return }
  if ($args[3] < 1)  { warn "ERROR: invalid 'len'\n"; return }
  #XXX-TODO utf8::encode($_[0]) if utf8::is_utf8($_[0]);
  $salt = random_bytes($$salt) if ref $salt eq 'SCALAR' && $$salt =~ /^\d+$/;
  my $key = _scrypt($_[0], $salt, @args);
  return wantarray ? ($key, $salt, $args[0], $args[1], $args[2]) : $key;
}

sub _slow_eq {
  my ($a, $b) = @_;
  return unless defined $a && defined $b;
  my $diff = length $a ^ length $b;
  for(my $i = 0; $i < length $a && $i < length $b; $i++) {
    $diff |= ord(substr $a, $i) ^ ord(substr $b, $i);
  }
  return $diff == 0;
}

1;

__END__