Version of "incore" for Windows executables. Original by Andy.
This commit is contained in:
Dr. Stephen Henson
parent
4feb7ef394
commit
83db979256
3 changed files with 369 additions and 0 deletions
4
CHANGES
4
CHANGES
|
|
@ -4,6 +4,10 @@
|
|||
|
||||
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
|
||||
be just copying input line across and this breaks some systems lacking
|
||||
ctime.
|
||||
|
|
|
|||
196
util/hmac_sha1.pl
Executable file
196
util/hmac_sha1.pl
Executable 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
169
util/msincore
Executable 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);
|
||||
Loading…
Add table
Add a link
Reference in a new issue