#!/usr/bin/perl -w
#
# Author:      tlviewer@yahoo.com
# script:       DHBigInt.pl
# Description: Open a Ver3 blob, parse out the DH Params, dynam. Instead of using Py script to verify calculations, use Math::BigInt
# keywords: crypt parse diffie hellman blob ver3 bigint pari
# Date:       05/10/04
# relatedDOC=DH_512.out
# relatedDOC=DH_768.out
# relatedDOC=DH_2048.out

use Fcntl;

#use Crypt::CBC;
use warnings;
use strict;

#use MIME::Base64;
#use Convert::ASCII::Armour;
use Digest::SHA qw(sha1 sha224 sha256 sha384 sha512);
use KDF;
use Digest::MD5 qw(md5 md5_hex);
use Crypt::DH;
use Math::BigInt lib => 'GMP';    # libgmp.dll is quite fast

$| = 1;

print "User=", Win32::LoginName(), "\n";

# read the DH key data into a hash, keyed by hash length
######################################################
my ( $dhdata, $CODE, $keylen );
$keylen = 512;
{
    local $/ = '';
    $CODE   = <DATA>;
    $dhdata = &{ eval "sub {$CODE}" };
}

#
#$dhdata = require "dhdata.dat";
print ref($dhdata), "\n", length( $dhdata->{$keylen}->{Gen} ), "\n";

#exit(0);
# got our hash

# Blowfish:56 Rijndael:(16,24,32) CAST5_PP:16 Twofish:16 DES_EDE3:24

# protect text "data"
$KDF::base_secret = "";

my ( $blob, $prime_len, $kp_xlen, $pos, $kp_jlen );

# for seek type
my $seek_type = 0x0;

# Open the DH CryptoAPI Ver3 blob for reading
sysopen( IN, "MyDH4\_$keylen\_DHServer.prk", O_BINARY )
  or die "failed to open Prk file";

$prime_len = GetBitLen(12);
print "Prime Len=", $prime_len, "\n";

$kp_xlen = GetBitLen(24);
print "KP_X Len=", $kp_xlen, "\n";

$kp_jlen = GetBitLen(20);
print "KP_J Len=", $kp_jlen, "\n";

my ( $prime, $gen, $y_pbk, $x );
$pos = 52;

# read & print the prime
#############################
$prime = ReadBlob( $pos, $prime_len );
print "prime =$prime\n";

$pos += $prime_len + $kp_xlen;

# read & print generator
##############################
$gen = ReadBlob( $pos, $prime_len );
print "gen \t=$gen\n";

$pos += $prime_len + $kp_jlen;

# read & print Y (ServerPbk)
##############################
$y_pbk = ReadBlob( $pos, $prime_len );

#$y_pbk = HexReverse( $y_pbk);
print "y_pbk =$y_pbk\n";

$pos += $prime_len;

# read & print X (random exponent)
##############################
$seek_type = 0x02;
$x         = ReadBlob( -$kp_xlen, $kp_xlen );    #ReadBlob( $pos, $kp_xlen);

# ReadBlob( -$kp_xlen, $kp_xlen);  #
$seek_type = 0;

#$x = HexReverse( $x);
print "X \t\t=$x\n";
close IN;

# read the Y random exponent from the client blob
#############################
sysopen( IN, "MyDH4\_$keylen\_DHClient.prk", O_BINARY )
  or die "failed to open Prk file";
my ( $y, $x_pbk );
$seek_type = 0x02;

$x_pbk = ReadBlob( -( 2 * $prime_len ), $prime_len );

#
#$x_pbk = HexReverse( $x_pbk);
print "x_pbk =$x_pbk\n";

$y = ReadBlob( -$prime_len, $prime_len );
print "Y \t\t=$y\n";

#
#$x_pbk = HexReverse( $x_pbk);
$seek_type = 0x00;
close IN;

# pypos is how we ignore leading and trailing junk from the ss result
my $pypos = 2 + 2 * $prime_len;

#
my $g  = Math::BigInt->new("0x$x_pbk");    # defaults to 0
my $xx = Math::BigInt->new("0x$x");
my $P  = Math::BigInt->new("0x$prime");
my $zss = Math::BigInt->new();
$zss = $g->bmodpow( $xx, $P );

#exit(0);

$pypos -= 2;
my $ss = $zss->as_hex();
$ss = substr( $ss, 2 );                    #,$pypos);

#
print "len=", length($ss), "\n";

#$ss = substr($ss,0,48);

# print shared secret
print "ss               =", $ss, "\n";

#
# DeriveKeyFromSecret
###########################
# reverse the hex bytes (to convert to LSB first)

$ss = HexReverse($ss);

#
# take the leftmost ...
#       32 bytes -- ARC4 128 bit key
#       48 bytes -- 3des 192 byte key (24 bits of parity)

my ( $skey, $tmp );
$skey = substr( $ss, 0, 48 );

# convert skey for parity (DES only)
$skey = KDF::ConvParity($skey);
print "Sky       =", $skey, "\n";    # unpack("H*", $skey)b

##################
# prepare to hash: convert the HEX to string
$tmp = Hex2String( HexReverse($skey) );    #substr(Hex2String($skey), 0, 24);
my $hsk = sha1($tmp);
print "hash   =", unpack( "H*", $hsk ), "\n";

# build an extended key
$skey = KDF::KeyDerive( $tmp, "sha1", 56, "WinNT" );    #  substr($ss,0,48)
print "ExtKey  =", unpack( "H*", $skey ), "\n";    # HashSession

#print StrReverse("12345");

# Now do a DH key exchange between CryptoAPI and Crypt::DH (Perl)
#####################################
my ( $xss, $zy_pbk ) = GenSharedSecret( $prime, $gen, $x_pbk );
my $biSS = Math::BigInt->new("$xss");
print "ss        =", $biSS->as_hex(), "\n";
$xx = Math::BigInt->new("0x$y");

$g  = Math::BigInt->new("$zy_pbk");    # defaults to 0
$zss = $g->bmodpow( $xx, $P );

#exit(0);

$ss = $zss->as_hex();
$ss = substr( $ss, 2 );                    #,$pypos);
#
print "len=", length($ss), "\n";

# print shared secret
print "ss               =", $ss, "\n";
exit(0);

# helper functions
#######################

sub Hex2String {
    my $tmp = shift;               #= substr($yy,0,24);
                                   #$tmp = substr($yy, 0 , 48); # HexReverse(
                                   #$tmp = $yy;
    my @jnk = $tmp =~ /\w{2}/ig;
    @jnk = map { chr( hex($_) ) } @jnk;
    $tmp = join( '', @jnk );
    print length($tmp), "\n";
    return $tmp;
}

sub ReadBlob {
    my ( $offset, $blen ) = @_;
    my ( $blob, $out );
    sysseek IN, $offset, $seek_type;
    sysread IN, $blob, $blen;
    return HexReverse( unpack( "H*", $blob ) );    # StrReverse(
}

sub GetBitLen {
    my ($offset) = shift;
    my ( $blen, $out );
    sysseek IN, $offset, 0;
    sysread IN, $blen, 4;
    $out = unpack( "L", $blen );
    $out /= 8;
    return $out;
}

sub HexReverse {

    # hex
    my $in = shift;

    #print length($in), "\n";
    my (@jnk) = $in =~ /\w{2}/ig;
    @jnk = map { chr( hex($_) ) } @jnk;

    #my @chk = split( '',$in);
    my $out = reverse @jnk;
    return unpack( "H*", $out );
}

sub StrReverse {

    # hex
    my $in = shift;

    #print length($in), "\n";
    my (@jnk) = split( //, $in );

    #@jnk = map {chr(hex($_))} @jnk;

    #my @chk = split( '',$in);
    return reverse @jnk;

    #return unpack("H*",$out);
}

#sub ConvParity {
#    my $snew;
#    my @jnk;
#    my $in = shift;
#    @jnk = ( $in =~ /\w{2}/ig );
#    @jnk = map { $KDF::ParConv[ eval( "0x" . $_ ) ] } @jnk;
#    return join( '', @jnk );
#}

sub GenSharedSecret {
#
    #
    # use the CPAN Crypt::DH module
    # use Crypt::DH;

    my ( $prime, $gen, $x_pbk ) = @_;
    my $dh = Crypt::DH->new;
    $dh->g("0x$gen");
    $dh->p("0x$prime");

    ## Generate public and private keys.
    $dh->generate_keys;
    print "Pbk=",ref($dh->pub_key), "\n";

    ## Send public key to "other" party, and receive "other"
    ## public key in return.

    ## Now compute shared secret from "other" public key.
        #
    my $ss = $dh->compute_key("0x$x_pbk");
        # " type=", ref(pari2iv($dh->pub_key)),
        print "type ss=", ref($ss), "  len ss=", length($ss), " len Pbk=", length( $dh->pub_key),  "\n";
    return (  $ss, $dh->pub_key );
}

sub _from_hex {
    my $h = $_[1];
    $$h =~ s/^[+-]//;                           # remove sign
    $$h = "0x$$h" unless $$h =~ /^0x/;          # make sure it starts with 0x
    Math::Pari::_hex_cvt($$h);
}

__END__
# CODE
 {
'512' => {
'Prime'     =>  'DD6B6874ABE871301AC055BE44C147CFD852991B9019A6338033344BD3A52DABB16D657460BFA0F23D49865E72EFC93013CB9E71168F3F57EC2D55FB8983E9E7',
'Gen'       =>  '59EBDB230D2DA254A42A24FBC8C574ED555442348E5580C122F0A22D4C048AEB1A3B33F7ECB6E6F9E03E6E6166382C90B2666973125620CC6DBC4B152A02C9BD',
'X_Pbk'     =>  'D0DE47E5254130BA5A6A7C2F93EED737F08DA57188574D7E612AC3F1135F59A8AA6396211A4FEECBBCB694BFA9757D4819B231BB82AF2D196B2632164882AC04',
'HashSK'    =>  '3E82A69C3ACD12F676B774CD8A695B119B3A1D4C',
'SK_PT'     =>  'CB2FE5EA49EFFB927C1515D543918C945726C815AE7F98CE',
'Y_Pbk'     =>  'A88E70B7BAADB90E347F5A56DE4241549926D19497767BA6E18CA5B2E2E8E1D1BDFEA81D309DADA442F1F1343F5A2244CE98D2577ABADB73E58676DA8F9EC765',
'Cipher'    =>  'vBrZBKd0ifLB6wmPd9VRCsz5Hllqb0RTN3Y5jdEP2po=',
'ExtKey'    =>  'D19412CFB17391C2C6A5441138DC5EB1CCBA69688ACEDEDA55DD2130C14492F8086697658B1719A0D765361127612EC7C309796903377878',
'type'          => '3des-192'
},              
'768' => {              
'Prime'     =>  'A1B00FD10C9FF6AD0F7774984FF9806082E725762E7E7F80C09CD89581F6D0F0CDA0D82D45CF7BDA2F4C3A072E0FC65B27A46A6CEDE2074C7AA5A43DAC630B2A7ACD7053BFF59DA71C8203D8B9E77892D2C62CE50F6CA20BD13E6D76B221A3E3',
'Gen'       =>  'B005680C6F2195DD15B50B1A77AF001D125CB5336A9533BEC7087DA57AC70D18C261C55AC64B257AEDE9A4CCD6DD6354D8CAE239B06A9DBB7AFAAE177F694F6BE04FD9C0C27DE2B70ADFE6CD54144754914EC8B8D5EF614D9204484FFF1AF71B',
'X_Pbk'     =>  '12FFF10909059EFB0549199AB402C72559C4EB12EBE67E25B64EFB3ECB65940330531C8DEEC27103763B99F2F0A46AB0C09B9F6386E3C0AE9FDD67DFBF3734F4A9613D0C43BD0830EBCF12D4D2C108BE36343AAA0E718C9F7811B8E07A6B3424',
'HashSK'    =>  '0C6F2793624E2C70385C2C24E0BDBA641806FE71',
'Y_Pbk'     =>  'E0C1ED1491F2E13C6D66E19412A7E9712CBF6092AE5D80BB227D4822DB2E5CB2D5579ECE75F8A22F201203919790F39E092BBFDE6C784A648F831F98E381A8F4806FE652DE0799B8437A01B48D04AE288092B201D47A339A9C12688913C8C572',
'Cipher'    =>  'PEsZbA72BOhr1/OUgLrmKLBknbkDB9xSQ24oGWo=',
'ExtKey'    =>  '11D7483EFBC284E32CBB3162D70D58E4AA7CEA1A943183CD289B5D7C76EE2E768C86E742DA92DA2C3C52CE6D26D74A95E5FA3BC6B3925C81',
'type'          => 'rc4-128'
},
'2048' =>  {    
'Prime'     =>  'B508E25FF4001AC663EAA0562A9AC916FF5E51B30D8ABC7E8EEA02B0848216914AA58F09F0546B3FA768A2C6361A598BB7173BE37C8D168644AF4A3BEE78E1C1F1EE0DF70AA13FD70170CF266474E0460F75531632F3F449D70858C881D66627179F2CB441D843FE5C235F82F46E8605EA6B1C0AC242F9D6A1C80FEB0BFB6D81CB874BF8FD164C5F98E085F2F8DF732E8FFE38D9D0BC1A6EE520DA75842B279B32FF8550D91A7EE5AFC4794FCD7EBD2B5A0DCC6077BD69D31C58822F7AD18E4D7B4AC4E7DF35FFBC2DCE649725AB4024BA636D79A6BF1AA5517163EC6B671A55933FEA09ADD7DA24680A99C6825D155CA98B50800F8D90F6BADEA5CCD03E2EF3',
'Gen'       =>  '04419614D886B32DD0EDF877D820DD425C50301BD48C887AE8C3B3BE350FB8B18E9FF2E8F31716F744E55494612B594132567094BD7CF658149C015404F52BAFFE8C1BCD23CD4C19B042B2321ECB323FBE594E7FB340CDD629ED1905D2356C5B87543B4F72EB934A3F759C3ED4FB43BF216A0B8C2D7B0450BEB7263D7AAF5613863F18BDFBE471084DE9A5204E850F5594F179ABAED22BCBBFE3220004DDC59506A5C6E8EDB5BA072AE464963056B79D237057C6EF00A3945F177B661787A30F83D022FD093A96F6FA28033974B6F8505313DE65A67FEE19BB17CF538DAE1D900997628F7C65C4EC414AF97B140FD6CA6F59D8A50056AD4D55B3E9C05F4B79AC',
'X_Pbk'     =>  'BE92F1C153AC96C661E1871B43D0164EF4941FA230C98573495ED405B41E5E7DAB8CA4A806ED38CCFE2B07CFCA361D8FD97F2E596040EC04FC077528B55DFA157EF7158D3DFF26B883624FE731B517F079F6B1E4A63E7F33909A8428A6A00F9C96B6E1F22DA57B76D9B0F5D6C0CA51638D3923BDF2D28DC3C68660177419D411076C8BCD6B3887696E0D2777C6D9D551285BF0BF89F68AE76CD1C480EAFE7B8D23A36713E91DC9DDDEBDF2104A40494A8E7713C2A738D2FACEFDD58851170EB66ADBD97D230CA995517B00CAB23589321F35620410ED13EBA8F80124AAE175E701D9C8A54E90B13B0F8A1BDE743CFEA7D1D956563691766878E03BB87D0F5EBF',
'HashSK'    =>  '2599BB35382E27D69D05722944ADBAEE426C896F',
'Y_Pbk'     =>  '444363BE980F8D0CB253E3921B57A9214460C4BA28EF21A13332C65CA3BAE5AE05CBC58D6DBDC835C6D907A2B203EAA8DB47B28E89C265468CAB1F2BA59C2A2E82E188CE5CBB3B1CA66E8D5ECDA4565EA2743B0EF8855C54DDE0F52301D74C631B1A0D448DF83A28CD8A8067479B8964D68D2B951E1A51BB064C076EE63348925AEB90DBFC3C9445710BC2FA6F3C8947A4364916B0F214D2945F865F810F0BC981EE35A51E91BB9DDF37D129552D82FC669F3CDF37830453C11C005AB64319CCDFA41D81C91346E2715D31D2D7BA56B2EC5B6B8E8FB1A143053DCB661EF05531802B0B26536530564E4F8E6B325AAF312309288F77B491005FE811824FF4FD48',
'Cipher'    =>  '30FXbA4M/CQPL165xfDgBgPPxi7HOe9jRovPV2yDv7s=',
'ExtKey'    =>  '063CDFA2F5DF4E85252D18B75790ADDCB77BBEDBE54CC6E712DA64E8051C5020F3366CF27D382154F18CB50F54FFC2090010BA529DCA0A9F',
'type'          => '3des-192'
}};