util/incore

   1 #! /usr/bin/env perl
   2 # Copyright 2011-2016 The OpenSSL Project Authors. All Rights Reserved.
   3 #
   4 # Licensed under the OpenSSL license (the "License").  You may not use
   5 # this file except in compliance with the License.  You can obtain a copy
   6 # in the file LICENSE in the source distribution or at
   7 # https://www.openssl.org/source/license.html
   8
   9 # The script embeds fingerprint into ELF executable object, either
  10 # application binary or shared library.
  11
  12 ######################################################################
  13 #
  14 # ELF symbol table parser by <appro@openssl.org>. The table entries
  15 # are extended with offset within executable file...
  16 #
  17 { package ELF;
  18   use FileHandle;
  19
  20     sub dup  { my %copy=map {$_} @_; return \%copy; }
  21
  22     sub Load {
  23         my $class = shift;
  24         my $self  = {};
  25         my $FD    = FileHandle->new();  # autoclose
  26
  27         bless $self,$class;
  28
  29         sysopen($FD,shift,0) or die "$!";
  30         binmode($FD);
  31
  32         #################################################
  33         # read and parse elf_ehdr.e_ident...
  34         #
  35         read($FD,my $elf,16) or die "$!";
  36
  37         my %e_ident;
  38         @e_ident{magic,class,data,version,osabi,abiver,pad}=
  39                 unpack("a4C*",$elf);
  40
  41         $!=42;          # signal fipsld to revert to two-step link
  42         die "not ELF file" if ($e_ident{magic} ne chr(0177)."ELF");
  43
  44         my $elf_bits   = $e_ident{class}*32;    # 32 or 64
  45         my $big_endian = $e_ident{data}-1;      # 0 or 1
  46
  47         if ($elf_bits==64) {
  48             if (!(((1<<31)<<1) && $big_endian==(unpack("L",pack("N",1))==1))) {
  49                 die "ELF64 is supported only natively";
  50             }
  51         }
  52
  53         #################################################
  54         # read and parse remainder of elf_ehdr...
  55         #
  56         read($FD,my $elfhdr,64) or die "$!";
  57
  58         my %elf_ehdr;
  59         @elf_ehdr{e_type,e_machine,e_version,
  60                 e_entry,e_phoff,e_shoff,e_flags,e_ehsize,
  61                 e_phentsize,e_phnum,e_shentsize,e_shnum,e_shstrndx} =
  62         $elf_bits==32 ?
  63                 unpack($big_endian?"nnN5n6":"vvV5v6",$elfhdr)
  64         :       unpack("SSLQ3LS6",$elfhdr);
  65
  66         # put aside e_machine in case one has to treat specific
  67         # platforms differently, see EM_ constants in elf.h for
  68         # assortment...
  69         $self->{e_machine} = $elf_ehdr{e_machine};
  70
  71         #################################################
  72         # read and parse elf_shdr table...
  73         #
  74         my ($i,$sz,$symtab_idx,$blob,$strings);
  75
  76         seek($FD,$elf_ehdr{e_shoff},0) or die "$!";
  77         read($FD,$blob,$elf_ehdr{e_shentsize}*$elf_ehdr{e_shnum}) or die "$!";
  78
  79         my @sections;
  80         my $elf_shdr_struct=($elf_bits==32?($big_endian?"N10":"V10"):"L2Q4L2Q2");
  81         for ($sz=$elf_ehdr{e_shentsize},$i=0;$i<length($blob);$i+=$sz) {
  82             my %elf_shdr;
  83
  84             @elf_shdr{sh_name,sh_type,sh_flags,
  85                         sh_addr,sh_offset,sh_size,
  86                         sh_link,sh_info,sh_addalign,sh_entsize} =
  87                 unpack($elf_shdr_struct,substr($blob,$i,$sz));
  88
  89             push(@sections,dup(%elf_shdr));
  90
  91             # note SHT_SYMTAB or SHT_DYNSYM for future reference
  92             if ($elf_shdr{sh_type}==2 || $elf_shdr{sh_type}==11) {
  93                 $symtab_idx = $#sections;
  94             }
  95         }
  96
  97         # read strings table and map section names...
  98         seek($FD,@sections[$elf_ehdr{e_shstrndx}]->{sh_offset},0)       or die "$!";
  99         read($FD,$strings,@sections[$elf_ehdr{e_shstrndx}]->{sh_size})  or die "$!";
 100         for (@sections) {
 101             $_->{sh_name}=(split(chr(0),substr($strings,$_->{sh_name},64)))[0];
 102         }
 103
 104         #################################################
 105         # read symbol strings table...
 106         #
 107         $i=@sections[$symtab_idx]->{sh_link};
 108         seek($FD,@sections[$i]->{sh_offset},0)          or die "$!";
 109         read($FD,$strings,@sections[$i]->{sh_size})     or die "$!";
 110
 111         #################################################
 112         # read and parse elf_sym table...
 113         #
 114         seek($FD,@sections[$symtab_idx]->{sh_offset},0)         or die "$!";
 115         read($FD,my $blob,@sections[$symtab_idx]->{sh_size})    or die "$!";
 116
 117         for ($sz=@sections[$symtab_idx]->{sh_entsize},$i=0;$i<length($blob);$i+=$sz) {
 118             my %elf_sym;
 119
 120             if ($elf_bits==32) {
 121                 @elf_sym{st_name,st_value,st_size,st_info,st_other,st_shndx} =
 122                         unpack($big_endian?"N3CCn":"V3CCv",substr($blob,$i,$sz));
 123             } else {
 124                 @elf_sym{st_name,st_info,st_other,st_shndx,st_value,st_size} =
 125                         unpack("LCCSQQ",substr($blob,$i,$sz));
 126             }
 127
 128             my $st_type = $elf_sym{st_info}&0xf;
 129             my $st_bind = $elf_sym{st_info}>>4;
 130             my $st_secn = $elf_sym{st_shndx};
 131             my $name;
 132             #                 (STT_OBJECT  || STT_FUNC)
 133             if ($st_bind<3 && ($st_type==1 || $st_type==2)
 134                 && $st_secn <= $#sections               # sane st_shndx
 135                 && @sections[$st_secn]->{sh_type}       # not SHN_UNDEF
 136                 && ($name=(split(chr(0),substr($strings,$elf_sym{st_name},128)))[0])
 137                 ) {
 138                 # synthesize st_offset, ...
 139                 $elf_sym{st_offset}  = $elf_sym{st_value}
 140                                 - @sections[$st_secn]->{sh_addr}
 141                                 + @sections[$st_secn]->{sh_offset};
 142                 $elf_sym{st_name}    = $name;
 143                 $elf_sym{st_section} = @sections[$st_secn]->{sh_name};
 144                 # ... and add to lookup table
 145                 $self->{symbols}{$name} = dup(%elf_sym);
 146             }
 147         }
 148
 149         return $self;
 150     }
 151
 152     sub Lookup {
 153         my $self = shift;
 154         my $name = shift;
 155         return $self->{symbols}{$name};
 156     }
 157
 158     sub Traverse {
 159         my $self = shift;
 160         my $code = shift;
 161
 162         if (ref($code) eq 'CODE') {
 163             for (keys(%{$self->{symbols}})) { &$code($self->{symbols}{$_}); }
 164         }
 165     }
 166 }
 167
 168 ######################################################################
 169 #
 170 # SHA1 and HMAC in Perl by <appro@openssl.org>.
 171 #
 172 { package SHA1;
 173   use integer;
 174
 175     {
 176     ################################### SHA1 block code generator
 177     my @V = ('$A','$B','$C','$D','$E');
 178     my $i;
 179
 180     sub XUpdate {
 181       my $ret;
 182         $ret="(\$T=\$W[($i-16)%16]^\$W[($i-14)%16]^\$W[($i-8)%16]^\$W[($i-3)%16],\n\t";
 183         if ((1<<31)<<1) {
 184             $ret.="    \$W[$i%16]=((\$T<<1)|(\$T>>31))&0xffffffff)\n\t  ";
 185         } else {
 186             $ret.="    \$W[$i%16]=(\$T<<1)|((\$T>>31)&1))\n\t  ";
 187         }
 188     }
 189     sub tail {
 190       my ($a,$b,$c,$d,$e)=@V;
 191       my $ret;
 192         if ((1<<31)<<1) {
 193             $ret.="(($a<<5)|($a>>27));\n\t";
 194             $ret.="$b=($b<<30)|($b>>2); $e&=0xffffffff; #$b&=0xffffffff;\n\t";
 195         } else {
 196             $ret.="(($a<<5)|($a>>27)&0x1f);\n\t";
 197             $ret.="$b=($b<<30)|($b>>2)&0x3fffffff;\n\t";
 198         }
 199       $ret;
 200     }
 201     sub BODY_00_15 {
 202         my ($a,$b,$c,$d,$e)=@V;
 203         "$e+=\$W[$i]+0x5a827999+((($c^$d)&$b)^$d)+".tail();
 204     }
 205     sub BODY_16_19 {
 206         my ($a,$b,$c,$d,$e)=@V;
 207         "$e+=".XUpdate()."+0x5a827999+((($c^$d)&$b)^$d)+".tail();
 208     }
 209     sub BODY_20_39 {
 210         my ($a,$b,$c,$d,$e)=@V;
 211         "$e+=".XUpdate()."+0x6ed9eba1+($b^$c^$d)+".tail();
 212     }
 213     sub BODY_40_59 {
 214         my ($a,$b,$c,$d,$e)=@V;
 215         "$e+=".XUpdate()."+0x8f1bbcdc+(($b&$c)|(($b|$c)&$d))+".tail();
 216     }
 217     sub BODY_60_79 {
 218         my ($a,$b,$c,$d,$e)=@V;
 219         "$e+=".XUpdate()."+0xca62c1d6+($b^$c^$d)+".tail();
 220     }
 221
 222     my $sha1_impl =
 223     'sub block {
 224         my $self = @_[0];
 225         my @W    = unpack("N16",@_[1]);
 226         my ($A,$B,$C,$D,$E,$T) = @{$self->{H}};
 227         ';
 228
 229         $sha1_impl.='
 230         $A &= 0xffffffff;
 231         $B &= 0xffffffff;
 232         ' if ((1<<31)<<1);
 233
 234         for($i=0;$i<16;$i++){ $sha1_impl.=BODY_00_15(); unshift(@V,pop(@V)); }
 235         for(;$i<20;$i++)    { $sha1_impl.=BODY_16_19(); unshift(@V,pop(@V)); }
 236         for(;$i<40;$i++)    { $sha1_impl.=BODY_20_39(); unshift(@V,pop(@V)); }
 237         for(;$i<60;$i++)    { $sha1_impl.=BODY_40_59(); unshift(@V,pop(@V)); }
 238         for(;$i<80;$i++)    { $sha1_impl.=BODY_60_79(); unshift(@V,pop(@V)); }
 239
 240         $sha1_impl.='
 241         $self->{H}[0]+=$A;      $self->{H}[1]+=$B;      $self->{H}[2]+=$C;
 242         $self->{H}[3]+=$D;      $self->{H}[4]+=$E;      }';
 243
 244     #print $sha1_impl,"\n";
 245     eval($sha1_impl);           # generate code
 246     }
 247
 248     sub Init {
 249         my $class = shift;      # multiple instances...
 250         my $self  = {};
 251
 252         bless $self,$class;
 253         $self->{H} = [0x67452301,0xefcdab89,0x98badcfe,0x10325476,0xc3d2e1f0];
 254         $self->{N} = 0;
 255         return $self;
 256     }
 257
 258     sub Update {
 259         my $self = shift;
 260         my $msg;
 261
 262         foreach $msg (@_) {
 263             my $len  = length($msg);
 264             my $num  = length($self->{buf});
 265             my $off  = 0;
 266
 267             $self->{N} += $len;
 268
 269             if (($num+$len)<64)
 270             {   $self->{buf} .= $msg; next;     }
 271             elsif ($num)
 272             {   $self->{buf} .= substr($msg,0,($off=64-$num));
 273                 $self->block($self->{buf});
 274             }
 275
 276             while(($off+64) <= $len)
 277             {   $self->block(substr($msg,$off,64));
 278                 $off += 64;
 279             }
 280
 281             $self->{buf} = substr($msg,$off);
 282         }
 283         return $self;
 284     }
 285
 286     sub Final {
 287         my $self = shift;
 288         my $num  = length($self->{buf});
 289
 290         $self->{buf} .= chr(0x80); $num++;
 291         if ($num>56)
 292         {   $self->{buf} .= chr(0)x(64-$num);
 293             $self->block($self->{buf});
 294             $self->{buf}=undef;
 295             $num=0;
 296         }
 297         $self->{buf} .= chr(0)x(56-$num);
 298         $self->{buf} .= pack("N2",($self->{N}>>29)&0x7,$self->{N}<<3);
 299         $self->block($self->{buf});
 300
 301         return pack("N*",@{$self->{H}});
 302     }
 303
 304     sub Selftest {
 305         my $hash;
 306
 307         $hash=SHA1->Init()->Update('abc')->Final();
 308         die "SHA1 test#1" if (unpack("H*",$hash) ne 'a9993e364706816aba3e25717850c26c9cd0d89d');
 309
 310         $hash=SHA1->Init()->Update('abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq')->Final();
 311         die "SHA1 test#2" if (unpack("H*",$hash) ne '84983e441c3bd26ebaae4aa1f95129e5e54670f1');
 312
 313         #$hash=SHA1->Init()->Update('a'x1000000)->Final();
 314         #die "SHA1 test#3" if (unpack("H*",$hash) ne '34aa973cd4c4daa4f61eeb2bdbad27316534016f');
 315     }
 316 }
 317
 318 { package HMAC;
 319
 320     sub Init {
 321         my $class = shift;
 322         my $key   = shift;
 323         my $self  = {};
 324
 325         bless $self,$class;
 326
 327         if (length($key)>64) {
 328             $key = SHA1->Init()->Update($key)->Final();
 329         }
 330         $key .= chr(0x00)x(64-length($key));
 331
 332         my @ikey = map($_^=0x36,unpack("C*",$key));
 333         ($self->{hash} = SHA1->Init())->Update(pack("C*",@ikey));
 334          $self->{okey} = pack("C*",map($_^=0x36^0x5c,@ikey));
 335
 336         return $self;
 337     }
 338
 339     sub Update {
 340         my $self = shift;
 341         $self->{hash}->Update(@_);
 342         return $self;
 343     }
 344
 345     sub Final {
 346         my $self  = shift;
 347         my $ihash = $self->{hash}->Final();
 348         return SHA1->Init()->Update($self->{okey},$ihash)->Final();
 349     }
 350
 351     sub Selftest {
 352         my $hmac;
 353
 354         $hmac = HMAC->Init('0123456789:;<=>?@ABC')->Update('Sample #2')->Final();
 355         die "HMAC test" if (unpack("H*",$hmac) ne '0922d3405faa3d194f82a45830737d5cc6c75d24');
 356     }
 357 }
 358
 359 ######################################################################
 360 #
 361 # main()
 362 #
 363 my $legacy_mode;
 364
 365 if ($ARGV<0 || ($#ARGV>0 && !($legacy_mode=(@ARGV[0] =~ /^\-(dso|exe)$/)))) {
 366         print STDERR "usage: $0 [-dso|-exe] elfbinary\n";
 367         exit(1);
 368 }
 369
 370 $exe = ELF->Load(@ARGV[$#ARGV]);
 371
 372 $FIPS_text_start        = $exe->Lookup("FIPS_text_start")               or die;
 373 $FIPS_text_end          = $exe->Lookup("FIPS_text_end")                 or die;
 374 $FIPS_rodata_start      = $exe->Lookup("FIPS_rodata_start")             or die;
 375 $FIPS_rodata_end        = $exe->Lookup("FIPS_rodata_end")               or die;
 376 $FIPS_signature         = $exe->Lookup("FIPS_signature")                or die;
 377
 378 # new cross-compile support
 379 $FIPS_text_startX       = $exe->Lookup("FIPS_text_startX");
 380 $FIPS_text_endX         = $exe->Lookup("FIPS_text_endX");
 381
 382 if (!$legacy_mode) {
 383     if (!$FIPS_text_startX || !$FIPS_text_endX) {
 384         print STDERR "@ARGV[$#ARGV] is not cross-compiler aware.\n";
 385         exit(42);       # signal fipsld to revert to two-step link
 386     }
 387
 388     $FINGERPRINT_ascii_value
 389                         = $exe->Lookup("FINGERPRINT_ascii_value");
 390
 391 }
 392 if ($FIPS_text_startX && $FIPS_text_endX) {
 393     $FIPS_text_start = $FIPS_text_startX;
 394     $FIPS_text_end   = $FIPS_text_endX;
 395 }
 396
 397 sysopen(FD,@ARGV[$#ARGV],$legacy_mode?0:2) or die "$!"; # 2 is read/write
 398 binmode(FD);
 399
 400 sub HMAC_Update {
 401   my ($hmac,$off,$len) = @_;
 402   my $blob;
 403
 404     seek(FD,$off,0)     or die "$!";
 405     read(FD,$blob,$len) or die "$!";
 406     $$hmac->Update($blob);
 407 }
 408
 409 # fips/fips.c:FIPS_incore_fingerprint's Perl twin
 410 #
 411 sub FIPS_incore_fingerprint {
 412   my $p1  = $FIPS_text_start->{st_offset};
 413   my $p2  = $FIPS_text_end->{st_offset};
 414   my $p3  = $FIPS_rodata_start->{st_offset};
 415   my $p4  = $FIPS_rodata_end->{st_offset};
 416   my $sig = $FIPS_signature->{st_offset};
 417   my $ctx = HMAC->Init("etaonrishdlcupfm");
 418
 419     # detect overlapping regions
 420     if ($p1<=$p3 && $p2>=$p3) {
 421         $p3 = $p1; $p4 = $p2>$p4?$p2:$p4; $p1 = 0; $p2 = 0;
 422     } elsif ($p3<=$p1 && $p4>=$p1) {
 423         $p3 = $p3; $p4 = $p2>$p4?$p2:$p4; $p1 = 0; $p2 = 0;
 424     }
 425
 426     if ($p1) {
 427         HMAC_Update (\$ctx,$p1,$p2-$p1);
 428     }
 429
 430     if ($sig>=$p3 && $sig<$p4) {
 431         # "punch" hole
 432         HMAC_Update(\$ctx,$p3,$sig-$p3);
 433         $p3 = $sig+20;
 434         HMAC_Update(\$ctx,$p3,$p4-$p3);
 435     } else {
 436         HMAC_Update(\$ctx,$p3,$p4-$p3);
 437     }
 438
 439     return $ctx->Final();
 440 }
 441
 442 $fingerprint = FIPS_incore_fingerprint();
 443
 444 if ($legacy_mode) {
 445     print unpack("H*",$fingerprint);
 446 } elsif (defined($FINGERPRINT_ascii_value)) {
 447     seek(FD,$FINGERPRINT_ascii_value->{st_offset},0)    or die "$!";
 448     print FD unpack("H*",$fingerprint)                  or die "$!";
 449 } else {
 450     seek(FD,$FIPS_signature->{st_offset},0)             or die "$!";
 451     print FD $fingerprint                               or die "$!";
 452 }
 453
 454 close (FD);