view release on metacpan or  search on metacpan

lib/Crypt/KeyWrap.pm  view on Meta::CPAN

package Crypt::KeyWrap;

use strict;
use warnings;

our $VERSION = '0.038';

use Exporter 'import';
our %EXPORT_TAGS = ( all => [qw(aes_key_wrap aes_key_unwrap gcm_key_wrap gcm_key_unwrap pbes2_key_wrap pbes2_key_unwrap ecdh_key_wrap ecdh_key_unwrap ecdhaes_key_wrap ecdhaes_key_unwrap rsa_key_wrap rsa_key_unwrap)] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw();

use Carp;
use Crypt::Mode::ECB;
use Crypt::AuthEnc::GCM qw(gcm_encrypt_authenticate gcm_decrypt_verify);
use Crypt::PRNG qw(random_bytes);
use Crypt::KeyDerivation qw(pbkdf2);
use Crypt::Digest qw(digest_data);
use Crypt::Misc qw(decode_b64u encode_b64u);
use Config;

# JWS: https://tools.ietf.org/html/rfc7515
# JWE: https://tools.ietf.org/html/rfc7516
# JWK: https://tools.ietf.org/html/rfc7517
# JWA: https://tools.ietf.org/html/rfc7518 - !!! this is important !!!

sub _LSB {
  my ($bytes, $data) = @_;
  my $len = length $data;
  return $len > $bytes ? substr($data, $len-$bytes, $bytes) : $data;
}

sub _MSB {
  my ($bytes, $data) = @_;
  my $len = length $data;
  return $len > $bytes ? substr($data, 0, $bytes) : $data;
}

sub _N2RAW {
  my ($bytes, $n) = @_;
  if ($bytes == 8) {
    return pack("N", 0) . pack("N", $n) if $Config{uvsize} == 4; #workaround
    return pack("N", $n >> 32) . pack("N", $n & 0xFFFFFFFF);
  }
  return pack("N", $n & 0xFFFFFFFF) if $bytes == 4;
}

sub _decode_ecdh_info {
  my ($name, $value) = @_;
  return '' unless defined $value;
  croak "concat_kdf: invalid $name" if ref $value;
  my $decoded = decode_b64u($value);
  croak "concat_kdf: invalid $name" unless defined $decoded && encode_b64u($decoded) eq $value;
  return $decoded;
}

sub aes_key_wrap {
  my ($kek, $pt_data, $cipher, $padding, $inverse) = @_;
  $cipher  = 'AES' unless defined $cipher;
  $padding = $cipher eq 'AES' ? 1 : 0 unless defined $padding;

  my ($A, $B, $P, $R);

  croak "aes_key_wrap: no KEK"     unless defined $kek;
  croak "aes_key_wrap: no PT data" unless defined $pt_data;
  my $klen = length $kek;
  croak "aes_key_wrap: invalid KEK length" unless $klen == 16 || $klen == 24 || $klen == 32;
  croak "aes_key_wrap: cipher must be AES or DES_EDE" unless $cipher eq 'AES' || $cipher eq 'DES_EDE';
  croak "aes_key_wrap: padding not allowed with DES_EDE" if $padding && $cipher eq 'DES_EDE';

  my $ECB = Crypt::Mode::ECB->new($cipher, 0);
  my $blck = $cipher eq 'DES_EDE' ? 4 : 8; # semiblock size in bytes, for AES 8, for 3DES 4

  # IV selection per RFC 3394 (KW, no padding) vs RFC 5649 (KWP, with padding).
  # Strict semantics: KWP always uses the alternate IV (A65959A6 || msg-len),
  # even when the message is already aligned, and KW always uses the standard
  # all-A6 IV. This matches the strict-mode behaviour Wycheproof tests for.
  my $len = length $pt_data;
  my $IV;
  if ($padding) {
    croak "aes_key_wrap: KWP only defined for AES (blck=8)" if $blck != 8;
    $IV = pack("H*", "A65959A6") . pack("N", $len);
    if ($len % $blck > 0) {
      $pt_data .= chr(0) x ($blck - ($len % $blck));
    }
  }
  else {
    croak "aes_key_wrap: pt_data length not multiply of $blck" if $len % $blck != 0;
    $IV = pack("H*", "A6" x $blck);
  }

  my $n = length($pt_data) / $blck;
  $P->[$_] = substr($pt_data, $_*$blck, $blck) for (0..$n-1);

  if ($n == 1) {
    return $inverse ? $ECB->decrypt($IV . $P->[0], $kek)
                    : $ECB->encrypt($IV . $P->[0], $kek);
  }

  $A = $IV;
  $R->[$_] = $P->[$_] for (0..$n-1);

  for my $j (0..5) {
    for my $i (0..$n-1) {
      $B = $inverse ? $ECB->decrypt($A . $R->[$i], $kek)
                    : $ECB->encrypt($A . $R->[$i], $kek);
      $A = _MSB($blck, $B) ^ _N2RAW($blck, ($n*$j)+$i+1);
      $R->[$i] = _LSB($blck, $B);
    }
  }

  my $rv = $A;
  $rv .= $R->[$_] for (0..$n-1);
  return $rv;