generic-library/openssl
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Version of "incore" for Windows executables. Original by Andy.

Browse Source
This commit is contained in:
Dr. Stephen Henson
2012-05-23 17:07:23 +00:00
parent 4feb7ef394
commit 83db979256
3 changed files with 369 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
CHANGES
View File

@@ -4,6 +4,10 @@
Changes between 1.0.1 and 1.1.0 [xx XXX xxxx] Changes between 1.0.1 and 1.1.0 [xx XXX xxxx]
*) Add perl scripts to calculate FIPS signatures for Windows
exectuables including WinCE.
[Andy Polyakov]
*) Don't attempt to insert current time into AES/3DES tests, we should *) Don't attempt to insert current time into AES/3DES tests, we should
be just copying input line across and this breaks some systems lacking be just copying input line across and this breaks some systems lacking
ctime. ctime.

196
util/hmac_sha1.pl Executable file
View File

@@ -0,0 +1,196 @@
#!/usr/bin/env perl
#
# Copyright (c) 2011 The OpenSSL Project.
#
######################################################################
#
# SHA1 and HMAC in Perl by <appro@openssl.org>.
#
{ package SHA1;
use integer;
{
################################### SHA1 block code generator
my @V = ('$A','$B','$C','$D','$E');
my $i;
sub XUpdate {
my $ret;
$ret="(\$T=\$W[($i-16)%16]^\$W[($i-14)%16]^\$W[($i-8)%16]^\$W[($i-3)%16],\n\t";
if ((1<<31)<<1) {
$ret.=" \$W[$i%16]=((\$T<<1)|(\$T>>31))&0xffffffff)\n\t ";
} else {
$ret.=" \$W[$i%16]=(\$T<<1)|((\$T>>31)&1))\n\t ";
}
}
sub tail {
my ($a,$b,$c,$d,$e)=@V;
my $ret;
if ((1<<31)<<1) {
$ret.="(($a<<5)|($a>>27));\n\t";
$ret.="$b=($b<<30)|($b>>2); $e&=0xffffffff; #$b&=0xffffffff;\n\t";
} else {
$ret.="(($a<<5)|($a>>27)&0x1f);\n\t";
$ret.="$b=($b<<30)|($b>>2)&0x3fffffff;\n\t";
}
$ret;
}
sub BODY_00_15 {
my ($a,$b,$c,$d,$e)=@V;
"$e+=\$W[$i]+0x5a827999+((($c^$d)&$b)^$d)+".tail();
}
sub BODY_16_19 {
my ($a,$b,$c,$d,$e)=@V;
"$e+=".XUpdate()."+0x5a827999+((($c^$d)&$b)^$d)+".tail();
}
sub BODY_20_39 {
my ($a,$b,$c,$d,$e)=@V;
"$e+=".XUpdate()."+0x6ed9eba1+($b^$c^$d)+".tail();
}
sub BODY_40_59 {
my ($a,$b,$c,$d,$e)=@V;
"$e+=".XUpdate()."+0x8f1bbcdc+(($b&$c)|(($b|$c)&$d))+".tail();
}
sub BODY_60_79 {
my ($a,$b,$c,$d,$e)=@V;
"$e+=".XUpdate()."+0xca62c1d6+($b^$c^$d)+".tail();
}
my $sha1_impl =
'sub block {
my $self = @_[0];
my @W = unpack("N16",@_[1]);
my ($A,$B,$C,$D,$E,$T) = @{$self->{H}};
';
$sha1_impl.='
$A &= 0xffffffff;
$B &= 0xffffffff;
' if ((1<<31)<<1);
for($i=0;$i<16;$i++){ $sha1_impl.=BODY_00_15(); unshift(@V,pop(@V)); }
for(;$i<20;$i++) { $sha1_impl.=BODY_16_19(); unshift(@V,pop(@V)); }
for(;$i<40;$i++) { $sha1_impl.=BODY_20_39(); unshift(@V,pop(@V)); }
for(;$i<60;$i++) { $sha1_impl.=BODY_40_59(); unshift(@V,pop(@V)); }
for(;$i<80;$i++) { $sha1_impl.=BODY_60_79(); unshift(@V,pop(@V)); }
$sha1_impl.='
$self->{H}[0]+=$A; $self->{H}[1]+=$B; $self->{H}[2]+=$C;
$self->{H}[3]+=$D; $self->{H}[4]+=$E; }';
#print $sha1_impl,"\n";
eval($sha1_impl); # generate code
}
sub Init {
my $class = shift; # multiple instances...
my $self = {};
bless $self,$class;
$self->{H} = [0x67452301,0xefcdab89,0x98badcfe,0x10325476,0xc3d2e1f0];
$self->{N} = 0;
return $self;
}
sub Update {
my $self = shift;
my $msg;
foreach $msg (@_) {
my $len = length($msg);
my $num = length($self->{buf});
my $off = 0;
$self->{N} += $len;
if (($num+$len)<64)
{ $self->{buf} .= $msg; next; }
elsif ($num)
{ $self->{buf} .= substr($msg,0,($off=64-$num));
$self->block($self->{buf});
}
while(($off+64) <= $len)
{ $self->block(substr($msg,$off,64));
$off += 64;
}
$self->{buf} = substr($msg,$off);
}
return $self;
}
sub Final {
my $self = shift;
my $num = length($self->{buf});
$self->{buf} .= chr(0x80); $num++;
if ($num>56)
{ $self->{buf} .= chr(0)x(64-$num);
$self->block($self->{buf});
$self->{buf}=undef;
$num=0;
}
$self->{buf} .= chr(0)x(56-$num);
$self->{buf} .= pack("N2",($self->{N}>>29)&0x7,$self->{N}<<3);
$self->block($self->{buf});
return pack("N*",@{$self->{H}});
}
sub Selftest {
my $hash;
$hash=SHA1->Init()->Update('abc')->Final();
die "SHA1 test#1" if (unpack("H*",$hash) ne 'a9993e364706816aba3e25717850c26c9cd0d89d');
$hash=SHA1->Init()->Update('abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq')->Final();
die "SHA1 test#2" if (unpack("H*",$hash) ne '84983e441c3bd26ebaae4aa1f95129e5e54670f1');
#$hash=SHA1->Init()->Update('a'x1000000)->Final();
#die "SHA1 test#3" if (unpack("H*",$hash) ne '34aa973cd4c4daa4f61eeb2bdbad27316534016f');
}
}
{ package HMAC;
sub Init {
my $class = shift;
my $key = shift;
my $self = {};
bless $self,$class;
if (length($key)>64) {
$key = SHA1->Init()->Update($key)->Final();
}
$key .= chr(0x00)x(64-length($key));
my @ikey = map($_^=0x36,unpack("C*",$key));
($self->{hash} = SHA1->Init())->Update(pack("C*",@ikey));
$self->{okey} = pack("C*",map($_^=0x36^0x5c,@ikey));
return $self;
}
sub Update {
my $self = shift;
$self->{hash}->Update(@_);
return $self;
}
sub Final {
my $self = shift;
my $ihash = $self->{hash}->Final();
return SHA1->Init()->Update($self->{okey},$ihash)->Final();
}
sub Selftest {
my $hmac;
$hmac = HMAC->Init('0123456789:;<=>?@ABC')->Update('Sample #2')->Final();
die "HMAC test" if (unpack("H*",$hmac) ne '0922d3405faa3d194f82a45830737d5cc6c75d24');
}
}
1;

169
util/msincore Executable file
View File

@@ -0,0 +1,169 @@
#!/usr/bin/env perl
#
# Copyright (c) 2012 The OpenSSL Project.
#
# The script embeds fingerprint into Microsoft PE-COFF executable object.
$0 =~ m/(.*[\/\\])[^\/\\]+$/; $dir=$1;
unshift(@INC,$dir);
require "hmac_sha1.pl";
######################################################################
#
# PE-COFF segment table parser by <appro@openssl.org>.
#
{ package PECOFF;
use FileHandle;
sub dup { my %copy=map {$_} @_; return \%copy; }
sub Load {
my $class = shift;
my $self = {};
my $FD = FileHandle->new(); # autoclose
my $file = shift;
bless $self,$class;
sysopen($FD,$file,0) or die "$!";
binmode($FD);
#################################################
# read IMAGE_DOS_HEADER
#
read($FD,my $mz,64) or die "$!";
my @dos_header=unpack("a2C58V",$mz);
$!=42; # signal fipsld to revert to two-step link
die "$file is not PE-COFF image" if (@dos_header[0] ne "MZ");
my $e_lfanew=pop(@dos_header);
seek($FD,$e_lfanew,0) or die "$!";
read($FD,my $magic,4) or die "$!";
$!=42; # signal fipsld to revert to two-step link
die "$file is not PE-COFF image" if (unpack("V",$magic)!=0x4550);
#################################################
# read and parse COFF header...
#
read($FD,my $coff,20) or die "$!";
my %coff_header;
@coff_header{machine,nsects,date,syms_off,nsyms,opt,flags}=
unpack("v2V3v2",$coff);
my $strings;
my $symsize;
#################################################
# load strings table
#
if ($coff_header{syms_off}) {
seek($FD,$coff_header{syms_off}+18*$coff_header{nsyms},0) or die "$!";
read($FD,$strings,4) or die "$!";
$symsize = unpack("V",$strings);
read($FD,$strings,$symsize,4) or die "$!";
}
#################################################
# read sections
#
my $i;
# seek to section headers
seek($FD,$e_lfanew+24+@coff_header{opt},0) or die "$!";
for ($i=0;$i<$coff_header{nsects};$i++) {
my %coff_shdr;
my $name;
read($FD,my $section,40) or die "$!";
@coff_shdr{sh_name,sh_vsize,sh_vaddr,
sh_rawsize,sh_offset,sh_relocs,sh_lines,
sh_nrelocls,sh_nlines,sh_flags} =
unpack("a8V6v2V",$section);
$name = $coff_shdr{sh_name};
# see if sh_name is an offset in $strings
my ($hi,$lo) = unpack("V2",$name);
if ($hi==0 && $lo<$symsize) {
$name = substr($strings,$lo,64);
}
$name = (split(chr(0),$name))[0];
$coff_shdr{sh_name} = $name;
$self->{sections}{$name} = dup(%coff_shdr);
}
return $self;
}
sub Lookup {
my $self = shift;
my $name = shift;
return $self->{sections}{$name};
}
}
######################################################################
#
# main()
#
my $legacy_mode;
if ($#ARGV<0 || ($#ARGV>0 && !($legacy_mode=(@ARGV[0] =~ /^\-(dso|exe)$/)))) {
print STDERR "usage: $0 [-dso|-exe] pe-coff-binary\n";
exit(1);
}
$exe = PECOFF->Load(@ARGV[$#ARGV]);
sysopen(FD,@ARGV[$#ARGV],$legacy_mode?0:2) or die "$!"; # 2 is read/write
binmode(FD);
sub FIPS_incore_fingerprint {
my $ctx = HMAC->Init("etaonrishdlcupfm");
my ($beg,$end);
my $sect;
$sect = $exe->Lookup("fipstx") or die "no fipstx section";
seek(FD,$sect->{sh_offset},0) or die "$!";
read(FD,$blob,$sect->{sh_vsize}) or die "$!";
($beg = index($blob,"SPIFxet_ts_tXtra")) >= 0
or die "no FIPS_text_startX";
($end = rindex($blob,"SPIFxet_ne_t][Xd")) >= 0
or die "no FIPS_text_endX";
$ctx->Update(substr($blob,$beg,$end-$beg));
$sect = $exe->Lookup("fipsro") or die "no fipsro section";
seek(FD,$sect->{sh_offset},0) or die "$!";
read(FD,$blob,$sect->{sh_vsize}) or die "$!";
($beg = index($blob,"SPIFdor__atarats",40)) >= 0
or die "no FIPS_rodata_start";
($end = rindex($blob,"SPIFdor__ata[dne")) >= 0
or die "no FIPS_rodata_end";
$ctx->Update(substr($blob,$beg,$end-$beg));
return $ctx->Final();
}
$fingerprint = FIPS_incore_fingerprint();
if ($legacy_mode) {
print unpack("H*",$fingerprint);
} else {
my $sect = $exe->Lookup("fipsro");
seek(FD,$sect->{sh_offset},0) or die "$!";
print FD unpack("H*",$fingerprint) or die "$!";
}
close (FD);