util/incore

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