From 83db979256f44d6ff5f7b1420ad77782ccec31a9 Mon Sep 17 00:00:00 2001 From: "Dr. Stephen Henson" Date: Wed, 23 May 2012 17:07:23 +0000 Subject: [PATCH] Version of "incore" for Windows executables. Original by Andy. --- CHANGES | 4 + util/hmac_sha1.pl | 196 ++++++++++++++++++++++++++++++++++++++++++++++ util/msincore | 169 +++++++++++++++++++++++++++++++++++++++ 3 files changed, 369 insertions(+) create mode 100755 util/hmac_sha1.pl create mode 100755 util/msincore diff --git a/CHANGES b/CHANGES index e8464c7ae3..8c8a09ce2b 100644 --- a/CHANGES +++ b/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. diff --git a/util/hmac_sha1.pl b/util/hmac_sha1.pl new file mode 100755 index 0000000000..494f7e8569 --- /dev/null +++ b/util/hmac_sha1.pl @@ -0,0 +1,196 @@ +#!/usr/bin/env perl +# +# Copyright (c) 2011 The OpenSSL Project. +# +###################################################################### +# +# SHA1 and HMAC in Perl by . +# +{ 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; diff --git a/util/msincore b/util/msincore new file mode 100755 index 0000000000..08f81be8d5 --- /dev/null +++ b/util/msincore @@ -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 . +# +{ 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); -- 2.25.1