package KDF;

# keywords: module template package export synopsis

#use strict;
require Exporter;
@ISA = (Exporter);

@EXPORT = qw( KeyDerive);

# import digest modules
###########################
use Digest::MD5 qw(md5);

#use Digest::HMAC_MD5 qw(hmac_md5);

# mark shelor (Digest::SHA 4.30 on CPAN)
use Digest::SHA qw(sha1 sha224 sha256 sha384 sha512);

# using the PureHmac(), we don't need these dedicated hmac imports
#hmac_sha1 hmac_sha224 hmac_sha256 hmac_sha384 hmac_sha512); # qw(sha1 sha1_hex);

# our protected text
our ($base_secret);

# Check DES keys for parity 5-16-2004
########################################
# 0 .. 255
our (@ParConv) = qw( 01 01 02 02 04 04 07 07 08 08 0b 0b 0d 0d 0e 0e 10
  10 13 13 15 15 16 16 19 19 1a 1a 1c 1c 1f 1f 20
  20 23 23 25 25 26 26 29 29 2a 2a 2c 2c 2f 2f 31
  31 32 32 34 34 37 37 38 38 3b 3b 3d 3d 3e 3e 40
  40 43 43 45 45 46 46 49 49 4a 4a 4c 4c 4f 4f 51
  51 52 52 54 54 57 57 58 58 5b 5b 5d 5d 5e 5e 61
  61 62 62 64 64 67 67 68 68 6b 6b 6d 6d 6e 6e 70
  70 73 73 75 75 76 76 79 79 7a 7a 7c 7c 7f 7f 80
  80 83 83 85 85 86 86 89 89 8a 8a 8c 8c 8f 8f 91
  91 92 92 94 94 97 97 98 98 9b 9b 9d 9d 9e 9e a1
  a1 a2 a2 a4 a4 a7 a7 a8 a8 ab ab ad ad ae ae b0
  b0 b3 b3 b5 b5 b6 b6 b9 b9 ba ba bc bc bf bf c1
  c1 c2 c2 c4 c4 c7 c7 c8 c8 cb cb cd cd ce ce d0
  d0 d3 d3 d5 d5 d6 d6 d9 d9 da da dc dc df df e0
  e0 e3 e3 e5 e5 e6 e6 e9 e9 ea ea ec ec ef ef f1
  f1 f2 f2 f4 f4 f7 f7 f8 f8 fb fb fd fd fe fe);


# hoc (hash of code refs)
#	 to store code references for the supported hash algo's
######################
my %hash_algo = (

    md5 => sub { return md5(shift) },

    sha1 => sub { return sha1(shift) },

    sha224 => sub { return sha224(shift) },

    sha256 => sub { return sha256(shift) },

    sha384 => sub { return sha384(shift) },

    sha512 => sub { return sha512(shift) }

      #		hmac_sha1 => sub { return hmac_sha1( @_ ) },
      #
      #		hmac_md5 => sub { return hmac_md5( @_ ) },
      #
      #		hmac_sha384 => sub { return hmac_sha384( @_ ) }
);

# hash of key derivation type code refs
########################
my %kdf_type = (
    WinNT => sub { return WinNT(@_) },

    PureHmac => sub { return PureHmac(@_) },

    DeriveKeyFromSecret => sub { return DeriveKeyFromSecret(@_) }
);

#
# KeyDerive
####################
# returns a binary key resulting from the kdf(passphrase)
sub KeyDerive {
    my ( $passwd, $algo, $nlen, $kdf ) = @_;

    # lookup the code ref for our algo
    my $h_algo   = $hash_algo{$algo};
    my $kdf_algo = $kdf_type{$kdf};

    if ( ref($kdf_algo) ne 'CODE' ) {
        require Carp;
        Carp::croak("Bad kdf type: $kdf_algo $!");
    }

    #print "ref=", ref($h_algo), "\n";
    if ( ref($h_algo) ne 'CODE' ) {
        require Carp;
        Carp::croak("Bad Algo Name: $algo $!");
    }

    my $temp = $kdf_algo->( $passwd, $h_algo, $nlen );
    print "tlen=", length($temp), "\n";
    my $klen = $nlen;
    while ( length($temp) < $nlen ) {
        $klen = $nlen - length($temp);
        $temp .= $kdf_algo->( $temp, $h_algo, $klen );
        print "tlen=", length($temp), "\n";
    }
    return $temp;
}

# WinNT5
###################
# method used in the Win32 CryptoAPI

sub WinNT {
    my ( $passwd, $h_algo, $klen ) = @_;

    my $hash = $h_algo->($passwd);

    my $inner = join( '', _hmac( chr(0x36), $hash ) );

    my $outer = join( '', _hmac( chr(0x5C), $hash ) );

    return substr( $h_algo->($inner) . $h_algo->($outer), 0, $klen );
}

# PureHmac
#####################
# the way rfc 2401 intended; does 2x the interations of WinNT

#' Definition of HMAC -- RFC 2401
#'    ipad = the byte 0x36 repeated B times
#'    opad = the byte 0x5C repeated B times.
#'
#'    To compute HMAC over the data `text' we perform
#'
#'    H(K XOR opad, H(K XOR ipad, text))

sub PureHmac {
    my ( $passwd, $h_algo, $klen ) = @_;

    my $hash = $h_algo->($passwd);

    if ( length($hash) >= length($passwd) ) {
        $hash = $passwd;
    }

    my $inner = join( '', _hmac( chr(0x36), $hash ) );

    my $outer = join( '', _hmac( chr(0x5C), $hash ) );

    return substr( $h_algo->( $outer . $h_algo->( $inner . $base_secret ) ),
        0, $klen );
}

# DeriveKeyFromSecret  (Must use imported Hmac algo)
##############
sub DeriveKeyFromSecret {
    my ( $dist, $h_algo, $klen ) = @_;
    my $hash = $h_algo->( $base_secret, $dist );
    return substr( $hash, 0, $klen );
}

# ConvParity (converts each byte of a hex string for DES parity)
##################################
sub ConvParity {
    my $snew;
    my @jnk;
    my $in = shift;
    @jnk = ( $in =~ /\w{2}/ig );
    @jnk = map { $ParConv[ eval( "0x" . $_ ) ] } @jnk;
    return join( '', @jnk );
}

# _hmac
###############
# private sub called from WinNT5

sub _hmac {
    my ( $mask, $in ) = @_;
    my @hmac = split //, $mask x 64;

    my @in = split //, $in;
    for my $n ( 0 .. length($in) - 1 ) {
        $hmac[$n] = $hmac[$n] ^ $in[$n];
    }

    #
    return @hmac;
}

1;
__END__

=head1 NAME

KDF - Key Derivation Function Interface

=head1 SYNOPSIS

   use KDF;

	use Crypt::CBC;
	use warnings;
	
	use KDF;
	use MIME::Base64;
	#use strict;
	# Blowfish:56 Rijndael:(16,24,32) CAST5_PP:16 Twofish:16 DES_EDE3:24
	
	my $skey = KDF::KeyDerive("1134-kelp","sha1", 56, "WinNT" );
	print unpack("H*", $skey), "\n";
	
	# derived key for sha1
	# d16edf877a5085a147bc5cff041045f9375e62ec3970f8aa
	
	my $cipher = Crypt::CBC->new( {'key'             => $skey,
	                        'cipher'          => 'Blowfish',
	                        'iv'              => 'AAAAAAAA',
	                        'regenerate_key'  => 0,   # this module controls the key
	                        'padding'         => 'standard',
	                        'prepend_iv'      => 0
                       	});
	my $all = "MS says open source is cancer\." ;
 
	my $ciphertext = $cipher->encrypt($all);
	print encode_base64($ciphertext), "\n";

=head1 DESCRIPTION

Interface to handle key derivation functions for a
	variety of hash digests and (long) key lengths.

The code begins after the "cut" statement.
=cut


=head1 AUTHOR

Mark Pryor, tlviewer@yahoo.com

This module is distributed under the ARTISTIC LICENSE using the same
terms as Perl itself.

=head1 SEE ALSO

perl(1), Crypt::DES(3), Crypt::IDEA(3), rfc2898 (PKCS#5), Crypt::CBC

=cut