169 lines
4 KiB
Perl
Executable file
169 lines
4 KiB
Perl
Executable file
#!/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);
|