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