1#! /usr/bin/env perl 2# Copyright 1995-2018 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# 10# generate a .def file 11# 12# It does this by parsing the header files and looking for the 13# prototyped functions: it then prunes the output. 14# 15# Intermediary files are created, call libcrypto.num and libssl.num, 16# The format of these files is: 17# 18# routine-name nnnn vers info 19# 20# The "nnnn" and "vers" fields are the numeric id and version for the symbol 21# respectively. The "info" part is actually a colon-separated string of fields 22# with the following meaning: 23# 24# existence:platform:kind:algorithms 25# 26# - "existence" can be "EXIST" or "NOEXIST" depending on if the symbol is 27# found somewhere in the source, 28# - "platforms" is empty if it exists on all platforms, otherwise it contains 29# comma-separated list of the platform, just as they are if the symbol exists 30# for those platforms, or prepended with a "!" if not. This helps resolve 31# symbol name variants for platforms where the names are too long for the 32# compiler or linker, or if the systems is case insensitive and there is a 33# clash, or the symbol is implemented differently (see 34# EXPORT_VAR_AS_FUNCTION). This script assumes renaming of symbols is found 35# in the file crypto/symhacks.h. 36# The semantics for the platforms is that every item is checked against the 37# environment. For the negative items ("!FOO"), if any of them is false 38# (i.e. "FOO" is true) in the environment, the corresponding symbol can't be 39# used. For the positive itms, if all of them are false in the environment, 40# the corresponding symbol can't be used. Any combination of positive and 41# negative items are possible, and of course leave room for some redundancy. 42# - "kind" is "FUNCTION" or "VARIABLE". The meaning of that is obvious. 43# - "algorithms" is a comma-separated list of algorithm names. This helps 44# exclude symbols that are part of an algorithm that some user wants to 45# exclude. 46# 47 48use lib "."; 49use configdata; 50use File::Spec::Functions; 51use File::Basename; 52use FindBin; 53use lib "$FindBin::Bin/perl"; 54use OpenSSL::Glob; 55 56# When building a "variant" shared library, with a custom SONAME, also customize 57# all the symbol versions. This produces a shared object that can coexist 58# without conflict in the same address space as a default build, or an object 59# with a different variant tag. 60# 61# For example, with a target definition that includes: 62# 63# shlib_variant => "-opt", 64# 65# we build the following objects: 66# 67# $ perl -le ' 68# for (@ARGV) { 69# if ($l = readlink) { 70# printf "%s -> %s\n", $_, $l 71# } else { 72# print 73# } 74# }' *.so* 75# libcrypto-opt.so.1.1 76# libcrypto.so -> libcrypto-opt.so.1.1 77# libssl-opt.so.1.1 78# libssl.so -> libssl-opt.so.1.1 79# 80# whose SONAMEs and dependencies are: 81# 82# $ for l in *.so; do 83# echo $l 84# readelf -d $l | egrep 'SONAME|NEEDED.*(ssl|crypto)' 85# done 86# libcrypto.so 87# 0x000000000000000e (SONAME) Library soname: [libcrypto-opt.so.1.1] 88# libssl.so 89# 0x0000000000000001 (NEEDED) Shared library: [libcrypto-opt.so.1.1] 90# 0x000000000000000e (SONAME) Library soname: [libssl-opt.so.1.1] 91# 92# We case-fold the variant tag to upper case and replace all non-alnum 93# characters with "_". This yields the following symbol versions: 94# 95# $ nm libcrypto.so | grep -w A 96# 0000000000000000 A OPENSSL_OPT_1_1_0 97# 0000000000000000 A OPENSSL_OPT_1_1_0a 98# 0000000000000000 A OPENSSL_OPT_1_1_0c 99# 0000000000000000 A OPENSSL_OPT_1_1_0d 100# 0000000000000000 A OPENSSL_OPT_1_1_0f 101# 0000000000000000 A OPENSSL_OPT_1_1_0g 102# $ nm libssl.so | grep -w A 103# 0000000000000000 A OPENSSL_OPT_1_1_0 104# 0000000000000000 A OPENSSL_OPT_1_1_0d 105# 106(my $SO_VARIANT = qq{\U$target{"shlib_variant"}}) =~ s/\W/_/g; 107 108my $debug=0; 109my $trace=0; 110my $verbose=0; 111 112my $crypto_num= catfile($config{sourcedir},"util","libcrypto.num"); 113my $ssl_num= catfile($config{sourcedir},"util","libssl.num"); 114my $libname; 115 116my $do_update = 0; 117my $do_rewrite = 1; 118my $do_crypto = 0; 119my $do_ssl = 0; 120my $do_ctest = 0; 121my $do_ctestall = 0; 122my $do_checkexist = 0; 123 124my $VMS=0; 125my $W32=0; 126my $NT=0; 127my $UNIX=0; 128my $linux=0; 129# Set this to make typesafe STACK definitions appear in DEF 130my $safe_stack_def = 0; 131 132my @known_platforms = ( "__FreeBSD__", "PERL5", 133 "EXPORT_VAR_AS_FUNCTION", "ZLIB", "_WIN32" 134 ); 135my @known_ossl_platforms = ( "UNIX", "VMS", "WIN32", "WINNT", "OS2" ); 136my @known_algorithms = ( # These are algorithms we know are guarded in relevant 137 # header files, but aren't actually disablable. 138 # Without these, this script will warn a lot. 139 "RSA", "MD5", 140 # @disablables comes from configdata.pm 141 map { (my $x = uc $_) =~ s|-|_|g; $x; } @disablables, 142 # Deprecated functions. Not really algorithmss, but 143 # treated as such here for the sake of simplicity 144 "DEPRECATEDIN_0_9_8", 145 "DEPRECATEDIN_1_0_0", 146 "DEPRECATEDIN_1_1_0", 147 ); 148 149# %disabled comes from configdata.pm 150my %disabled_algorithms = 151 map { (my $x = uc $_) =~ s|-|_|g; $x => 1; } keys %disabled; 152 153my $zlib; 154 155foreach (@ARGV, split(/ /, $config{options})) 156 { 157 $debug=1 if $_ eq "debug"; 158 $trace=1 if $_ eq "trace"; 159 $verbose=1 if $_ eq "verbose"; 160 $W32=1 if $_ eq "32"; 161 die "win16 not supported" if $_ eq "16"; 162 if($_ eq "NT") { 163 $W32 = 1; 164 $NT = 1; 165 } 166 if ($_ eq "linux") { 167 $linux=1; 168 $UNIX=1; 169 } 170 $VMS=1 if $_ eq "VMS"; 171 if ($_ eq "zlib" || $_ eq "enable-zlib" || $_ eq "zlib-dynamic" 172 || $_ eq "enable-zlib-dynamic") { 173 $zlib = 1; 174 } 175 176 $do_ssl=1 if $_ eq "libssl"; 177 if ($_ eq "ssl") { 178 $do_ssl=1; 179 $libname=$_ 180 } 181 $do_crypto=1 if $_ eq "libcrypto"; 182 if ($_ eq "crypto") { 183 $do_crypto=1; 184 $libname=$_; 185 } 186 $do_update=1 if $_ eq "update"; 187 $do_rewrite=1 if $_ eq "rewrite"; 188 $do_ctest=1 if $_ eq "ctest"; 189 $do_ctestall=1 if $_ eq "ctestall"; 190 $do_checkexist=1 if $_ eq "exist"; 191 if (/^--api=(\d+)\.(\d+)\.(\d+)$/) { 192 my $apiv = sprintf "%x%02x%02x", $1, $2, $3; 193 foreach (@known_algorithms) { 194 if (/^DEPRECATEDIN_(\d+)_(\d+)_(\d+)$/) { 195 my $depv = sprintf "%x%02x%02x", $1, $2, $3; 196 $disabled_algorithms{$_} = 1 if $apiv ge $depv; 197 } 198 } 199 } 200 if (/^no-deprecated$/) { 201 foreach (@known_algorithms) { 202 if (/^DEPRECATEDIN_/) { 203 $disabled_algorithms{$_} = 1; 204 } 205 } 206 } 207 elsif (/^(enable|disable|no)-(.*)$/) { 208 my $alg = uc $2; 209 $alg =~ tr/-/_/; 210 if (exists $disabled_algorithms{$alg}) { 211 $disabled_algorithms{$alg} = $1 eq "enable" ? 0 : 1; 212 } 213 } 214 215 } 216 217if (!$libname) { 218 if ($do_ssl) { 219 $libname="LIBSSL"; 220 } 221 if ($do_crypto) { 222 $libname="LIBCRYPTO"; 223 } 224} 225 226# If no platform is given, assume WIN32 227if ($W32 + $VMS + $linux == 0) { 228 $W32 = 1; 229} 230die "Please, only one platform at a time" 231 if ($W32 + $VMS + $linux > 1); 232 233if (!$do_ssl && !$do_crypto) 234 { 235 print STDERR "usage: $0 ( ssl | crypto ) [ 16 | 32 | NT | OS2 | linux | VMS ]\n"; 236 exit(1); 237 } 238 239%ssl_list=&load_numbers($ssl_num); 240$max_ssl = $max_num; 241%crypto_list=&load_numbers($crypto_num); 242$max_crypto = $max_num; 243 244my $ssl="include/openssl/ssl.h"; 245$ssl.=" include/openssl/tls1.h"; 246$ssl.=" include/openssl/srtp.h"; 247 248# We use headers found in include/openssl and include/internal only. 249# The latter is needed so libssl.so/.dll/.exe can link properly. 250my $crypto ="include/openssl/crypto.h"; 251$crypto.=" include/internal/o_dir.h"; 252$crypto.=" include/internal/o_str.h"; 253$crypto.=" include/internal/err.h"; 254$crypto.=" include/internal/asn1t.h"; 255$crypto.=" include/openssl/des.h" ; # unless $no_des; 256$crypto.=" include/openssl/idea.h" ; # unless $no_idea; 257$crypto.=" include/openssl/rc4.h" ; # unless $no_rc4; 258$crypto.=" include/openssl/rc5.h" ; # unless $no_rc5; 259$crypto.=" include/openssl/rc2.h" ; # unless $no_rc2; 260$crypto.=" include/openssl/blowfish.h" ; # unless $no_bf; 261$crypto.=" include/openssl/cast.h" ; # unless $no_cast; 262$crypto.=" include/openssl/whrlpool.h" ; 263$crypto.=" include/openssl/md2.h" ; # unless $no_md2; 264$crypto.=" include/openssl/md4.h" ; # unless $no_md4; 265$crypto.=" include/openssl/md5.h" ; # unless $no_md5; 266$crypto.=" include/openssl/mdc2.h" ; # unless $no_mdc2; 267$crypto.=" include/openssl/sha.h" ; # unless $no_sha; 268$crypto.=" include/openssl/ripemd.h" ; # unless $no_ripemd; 269$crypto.=" include/openssl/aes.h" ; # unless $no_aes; 270$crypto.=" include/openssl/camellia.h" ; # unless $no_camellia; 271$crypto.=" include/openssl/seed.h"; # unless $no_seed; 272 273$crypto.=" include/openssl/bn.h"; 274$crypto.=" include/openssl/rsa.h" ; # unless $no_rsa; 275$crypto.=" include/openssl/dsa.h" ; # unless $no_dsa; 276$crypto.=" include/openssl/dh.h" ; # unless $no_dh; 277$crypto.=" include/openssl/ec.h" ; # unless $no_ec; 278$crypto.=" include/openssl/hmac.h" ; # unless $no_hmac; 279$crypto.=" include/openssl/cmac.h" ; 280 281$crypto.=" include/openssl/engine.h"; # unless $no_engine; 282$crypto.=" include/openssl/stack.h" ; # unless $no_stack; 283$crypto.=" include/openssl/buffer.h" ; # unless $no_buffer; 284$crypto.=" include/openssl/bio.h" ; # unless $no_bio; 285$crypto.=" include/internal/dso.h" ; # unless $no_dso; 286$crypto.=" include/openssl/lhash.h" ; # unless $no_lhash; 287$crypto.=" include/openssl/conf.h"; 288$crypto.=" include/openssl/txt_db.h"; 289 290$crypto.=" include/openssl/evp.h" ; # unless $no_evp; 291$crypto.=" include/openssl/objects.h"; 292$crypto.=" include/openssl/pem.h"; 293#$crypto.=" include/openssl/meth.h"; 294$crypto.=" include/openssl/asn1.h"; 295$crypto.=" include/openssl/asn1t.h"; 296$crypto.=" include/openssl/err.h" ; # unless $no_err; 297$crypto.=" include/openssl/pkcs7.h"; 298$crypto.=" include/openssl/pkcs12.h"; 299$crypto.=" include/openssl/x509.h"; 300$crypto.=" include/openssl/x509_vfy.h"; 301$crypto.=" include/openssl/x509v3.h"; 302$crypto.=" include/openssl/ts.h"; 303$crypto.=" include/openssl/rand.h"; 304$crypto.=" include/openssl/comp.h" ; # unless $no_comp; 305$crypto.=" include/openssl/ocsp.h"; 306$crypto.=" include/openssl/ui.h"; 307#$crypto.=" include/openssl/store.h"; 308$crypto.=" include/openssl/cms.h"; 309$crypto.=" include/openssl/srp.h"; 310$crypto.=" include/openssl/modes.h"; 311$crypto.=" include/openssl/async.h"; 312$crypto.=" include/openssl/ct.h"; 313$crypto.=" include/openssl/kdf.h"; 314 315my $symhacks="include/openssl/symhacks.h"; 316 317my @ssl_symbols = &do_defs("LIBSSL", $ssl, $symhacks); 318my @crypto_symbols = &do_defs("LIBCRYPTO", $crypto, $symhacks); 319 320if ($do_update) { 321 322if ($do_ssl == 1) { 323 324 &maybe_add_info("LIBSSL",*ssl_list,@ssl_symbols); 325 if ($do_rewrite == 1) { 326 open(OUT, ">$ssl_num"); 327 &rewrite_numbers(*OUT,"LIBSSL",*ssl_list,@ssl_symbols); 328 } else { 329 open(OUT, ">>$ssl_num"); 330 } 331 &update_numbers(*OUT,"LIBSSL",*ssl_list,$max_ssl,@ssl_symbols); 332 close OUT; 333} 334 335if($do_crypto == 1) { 336 337 &maybe_add_info("LIBCRYPTO",*crypto_list,@crypto_symbols); 338 if ($do_rewrite == 1) { 339 open(OUT, ">$crypto_num"); 340 &rewrite_numbers(*OUT,"LIBCRYPTO",*crypto_list,@crypto_symbols); 341 } else { 342 open(OUT, ">>$crypto_num"); 343 } 344 &update_numbers(*OUT,"LIBCRYPTO",*crypto_list,$max_crypto,@crypto_symbols); 345 close OUT; 346} 347 348} elsif ($do_checkexist) { 349 &check_existing(*ssl_list, @ssl_symbols) 350 if $do_ssl == 1; 351 &check_existing(*crypto_list, @crypto_symbols) 352 if $do_crypto == 1; 353} elsif ($do_ctest || $do_ctestall) { 354 355 print <<"EOF"; 356 357/* Test file to check all DEF file symbols are present by trying 358 * to link to all of them. This is *not* intended to be run! 359 */ 360 361int main() 362{ 363EOF 364 &print_test_file(*STDOUT,"LIBSSL",*ssl_list,$do_ctestall,@ssl_symbols) 365 if $do_ssl == 1; 366 367 &print_test_file(*STDOUT,"LIBCRYPTO",*crypto_list,$do_ctestall,@crypto_symbols) 368 if $do_crypto == 1; 369 370 print "}\n"; 371 372} else { 373 374 &print_def_file(*STDOUT,$libname,*ssl_list,@ssl_symbols) 375 if $do_ssl == 1; 376 377 &print_def_file(*STDOUT,$libname,*crypto_list,@crypto_symbols) 378 if $do_crypto == 1; 379 380} 381 382 383sub do_defs 384{ 385 my($name,$files,$symhacksfile)=@_; 386 my $file; 387 my @ret; 388 my %syms; 389 my %platform; # For anything undefined, we assume "" 390 my %kind; # For anything undefined, we assume "FUNCTION" 391 my %algorithm; # For anything undefined, we assume "" 392 my %variant; 393 my %variant_cnt; # To be able to allocate "name{n}" if "name" 394 # is the same name as the original. 395 my $cpp; 396 my %unknown_algorithms = (); 397 my $parens = 0; 398 399 foreach $file (split(/\s+/,$symhacksfile." ".$files)) 400 { 401 my $fn = catfile($config{sourcedir},$file); 402 print STDERR "TRACE: start reading $fn\n" if $trace; 403 open(IN,"<$fn") || die "unable to open $fn:$!\n"; 404 my $line = "", my $def= ""; 405 my %tag = ( 406 (map { $_ => 0 } @known_platforms), 407 (map { "OPENSSL_SYS_".$_ => 0 } @known_ossl_platforms), 408 (map { "OPENSSL_NO_".$_ => 0 } @known_algorithms), 409 (map { "OPENSSL_USE_".$_ => 0 } @known_algorithms), 410 NOPROTO => 0, 411 PERL5 => 0, 412 _WINDLL => 0, 413 CONST_STRICT => 0, 414 TRUE => 1, 415 ); 416 my $symhacking = $file eq $symhacksfile; 417 my @current_platforms = (); 418 my @current_algorithms = (); 419 420 # params: symbol, alias, platforms, kind 421 # The reason to put this subroutine in a variable is that 422 # it will otherwise create it's own, unshared, version of 423 # %tag and %variant... 424 my $make_variant = sub 425 { 426 my ($s, $a, $p, $k) = @_; 427 my ($a1, $a2); 428 429 print STDERR "DEBUG: make_variant: Entered with ",$s,", ",$a,", ",(defined($p)?$p:""),", ",(defined($k)?$k:""),"\n" if $debug; 430 if (defined($p)) 431 { 432 $a1 = join(",",$p, 433 grep(!/^$/, 434 map { $tag{$_} == 1 ? $_ : "" } 435 @known_platforms)); 436 } 437 else 438 { 439 $a1 = join(",", 440 grep(!/^$/, 441 map { $tag{$_} == 1 ? $_ : "" } 442 @known_platforms)); 443 } 444 $a2 = join(",", 445 grep(!/^$/, 446 map { $tag{"OPENSSL_SYS_".$_} == 1 ? $_ : "" } 447 @known_ossl_platforms)); 448 print STDERR "DEBUG: make_variant: a1 = $a1; a2 = $a2\n" if $debug; 449 if ($a1 eq "") { $a1 = $a2; } 450 elsif ($a1 ne "" && $a2 ne "") { $a1 .= ",".$a2; } 451 if ($a eq $s) 452 { 453 if (!defined($variant_cnt{$s})) 454 { 455 $variant_cnt{$s} = 0; 456 } 457 $variant_cnt{$s}++; 458 $a .= "{$variant_cnt{$s}}"; 459 } 460 my $toadd = $a.":".$a1.(defined($k)?":".$k:""); 461 my $togrep = $s.'(\{[0-9]+\})?:'.$a1.(defined($k)?":".$k:""); 462 if (!grep(/^$togrep$/, 463 split(/;/, defined($variant{$s})?$variant{$s}:""))) { 464 if (defined($variant{$s})) { $variant{$s} .= ";"; } 465 $variant{$s} .= $toadd; 466 } 467 print STDERR "DEBUG: make_variant: Exit with variant of ",$s," = ",$variant{$s},"\n" if $debug; 468 }; 469 470 print STDERR "DEBUG: parsing ----------\n" if $debug; 471 while(<IN>) { 472 s|\R$||; # Better chomp 473 if($parens > 0) { 474 #Inside a DEPRECATEDIN 475 $stored_multiline .= $_; 476 print STDERR "DEBUG: Continuing multiline DEPRECATEDIN: $stored_multiline\n" if $debug; 477 $parens = count_parens($stored_multiline); 478 if ($parens == 0) { 479 $def .= do_deprecated($stored_multiline, 480 \@current_platforms, 481 \@current_algorithms); 482 } 483 next; 484 } 485 if (/\/\* Error codes for the \w+ functions\. \*\//) 486 { 487 undef @tag; 488 last; 489 } 490 if ($line ne '') { 491 $_ = $line . $_; 492 $line = ''; 493 } 494 495 if (/\\$/) { 496 $line = $`; # keep what was before the backslash 497 next; 498 } 499 500 if(/\/\*/) { 501 if (not /\*\//) { # multiline comment... 502 $line = $_; # ... just accumulate 503 next; 504 } else { 505 s/\/\*.*?\*\///gs;# wipe it 506 } 507 } 508 509 if ($cpp) { 510 $cpp++ if /^#\s*if/; 511 $cpp-- if /^#\s*endif/; 512 next; 513 } 514 if (/^#.*ifdef.*cplusplus/) { 515 $cpp = 1; 516 next; 517 } 518 519 s/{[^{}]*}//gs; # ignore {} blocks 520 print STDERR "DEBUG: \$def=\"$def\"\n" if $debug && $def ne ""; 521 print STDERR "DEBUG: \$_=\"$_\"\n" if $debug; 522 if (/^\#\s*ifndef\s+(.*)/) { 523 push(@tag,"-"); 524 push(@tag,$1); 525 $tag{$1}=-1; 526 print STDERR "DEBUG: $file: found tag $1 = -1\n" if $debug; 527 } elsif (/^\#\s*if\s+!defined\s*\(([^\)]+)\)/) { 528 push(@tag,"-"); 529 if (/^\#\s*if\s+(!defined\s*\(([^\)]+)\)(\s+\&\&\s+!defined\s*\(([^\)]+)\))*)$/) { 530 my $tmp_1 = $1; 531 my $tmp_; 532 foreach $tmp_ (split '\&\&',$tmp_1) { 533 $tmp_ =~ /!defined\s*\(([^\)]+)\)/; 534 print STDERR "DEBUG: $file: found tag $1 = -1\n" if $debug; 535 push(@tag,$1); 536 $tag{$1}=-1; 537 } 538 } else { 539 print STDERR "Warning: $file: taking only '!defined($1)' of complicated expression: $_" if $verbose; # because it is O... 540 print STDERR "DEBUG: $file: found tag $1 = -1\n" if $debug; 541 push(@tag,$1); 542 $tag{$1}=-1; 543 } 544 } elsif (/^\#\s*ifdef\s+(\S*)/) { 545 push(@tag,"-"); 546 push(@tag,$1); 547 $tag{$1}=1; 548 print STDERR "DEBUG: $file: found tag $1 = 1\n" if $debug; 549 } elsif (/^\#\s*if\s+defined\s*\(([^\)]+)\)/) { 550 push(@tag,"-"); 551 if (/^\#\s*if\s+(defined\s*\(([^\)]+)\)(\s+\|\|\s+defined\s*\(([^\)]+)\))*)$/) { 552 my $tmp_1 = $1; 553 my $tmp_; 554 foreach $tmp_ (split '\|\|',$tmp_1) { 555 $tmp_ =~ /defined\s*\(([^\)]+)\)/; 556 print STDERR "DEBUG: $file: found tag $1 = 1\n" if $debug; 557 push(@tag,$1); 558 $tag{$1}=1; 559 } 560 } else { 561 print STDERR "Warning: $file: taking only 'defined($1)' of complicated expression: $_\n" if $verbose; # because it is O... 562 print STDERR "DEBUG: $file: found tag $1 = 1\n" if $debug; 563 push(@tag,$1); 564 $tag{$1}=1; 565 } 566 } elsif (/^\#\s*error\s+(\w+) is disabled\./) { 567 my $tag_i = $#tag; 568 while($tag[$tag_i] ne "-") { 569 if ($tag[$tag_i] eq "OPENSSL_NO_".$1) { 570 $tag{$tag[$tag_i]}=2; 571 print STDERR "DEBUG: $file: chaged tag $1 = 2\n" if $debug; 572 } 573 $tag_i--; 574 } 575 } elsif (/^\#\s*endif/) { 576 my $tag_i = $#tag; 577 while($tag_i > 0 && $tag[$tag_i] ne "-") { 578 my $t=$tag[$tag_i]; 579 print STDERR "DEBUG: \$t=\"$t\"\n" if $debug; 580 if ($tag{$t}==2) { 581 $tag{$t}=-1; 582 } else { 583 $tag{$t}=0; 584 } 585 print STDERR "DEBUG: $file: changed tag ",$t," = ",$tag{$t},"\n" if $debug; 586 pop(@tag); 587 if ($t =~ /^OPENSSL_NO_([A-Z0-9_]+)$/) { 588 $t=$1; 589 } elsif($t =~ /^OPENSSL_USE_([A-Z0-9_]+)$/) { 590 $t=$1; 591 } else { 592 $t=""; 593 } 594 if ($t ne "" 595 && !grep(/^$t$/, @known_algorithms)) { 596 $unknown_algorithms{$t} = 1; 597 #print STDERR "DEBUG: Added as unknown algorithm: $t\n" if $debug; 598 } 599 $tag_i--; 600 } 601 pop(@tag); 602 } elsif (/^\#\s*else/) { 603 my $tag_i = $#tag; 604 die "$file unmatched else\n" if $tag_i < 0; 605 while($tag[$tag_i] ne "-") { 606 my $t=$tag[$tag_i]; 607 $tag{$t}= -$tag{$t}; 608 print STDERR "DEBUG: $file: changed tag ",$t," = ",$tag{$t},"\n" if $debug; 609 $tag_i--; 610 } 611 } elsif (/^\#\s*if\s+1/) { 612 push(@tag,"-"); 613 # Dummy tag 614 push(@tag,"TRUE"); 615 $tag{"TRUE"}=1; 616 print STDERR "DEBUG: $file: found 1\n" if $debug; 617 } elsif (/^\#\s*if\s+0/) { 618 push(@tag,"-"); 619 # Dummy tag 620 push(@tag,"TRUE"); 621 $tag{"TRUE"}=-1; 622 print STDERR "DEBUG: $file: found 0\n" if $debug; 623 } elsif (/^\#\s*if\s+/) { 624 #Some other unrecognized "if" style 625 push(@tag,"-"); 626 print STDERR "Warning: $file: ignoring unrecognized expression: $_\n" if $verbose; # because it is O... 627 } elsif (/^\#\s*define\s+(\w+)\s+(\w+)/ 628 && $symhacking && $tag{'TRUE'} != -1) { 629 # This is for aliasing. When we find an alias, 630 # we have to invert 631 &$make_variant($1,$2); 632 print STDERR "DEBUG: $file: defined $1 = $2\n" if $debug; 633 } 634 if (/^\#/) { 635 @current_platforms = 636 grep(!/^$/, 637 map { $tag{$_} == 1 ? $_ : 638 $tag{$_} == -1 ? "!".$_ : "" } 639 @known_platforms); 640 push @current_platforms 641 , grep(!/^$/, 642 map { $tag{"OPENSSL_SYS_".$_} == 1 ? $_ : 643 $tag{"OPENSSL_SYS_".$_} == -1 ? "!".$_ : "" } 644 @known_ossl_platforms); 645 @current_algorithms = (); 646 @current_algorithms = 647 grep(!/^$/, 648 map { $tag{"OPENSSL_NO_".$_} == -1 ? $_ : "" } 649 @known_algorithms); 650 push @current_algorithms 651 , grep(!/^$/, 652 map { $tag{"OPENSSL_USE_".$_} == 1 ? $_ : "" } 653 @known_algorithms); 654 $def .= 655 "#INFO:" 656 .join(',',@current_platforms).":" 657 .join(',',@current_algorithms).";"; 658 next; 659 } 660 if ($tag{'TRUE'} != -1) { 661 if (/^\s*DEFINE_STACK_OF\s*\(\s*(\w*)\s*\)/ 662 || /^\s*DEFINE_STACK_OF_CONST\s*\(\s*(\w*)\s*\)/) { 663 next; 664 } elsif (/^\s*DECLARE_ASN1_ENCODE_FUNCTIONS\s*\(\s*(\w*)\s*,\s*(\w*)\s*,\s*(\w*)\s*\)/) { 665 $def .= "int d2i_$3(void);"; 666 $def .= "int i2d_$3(void);"; 667 # Variant for platforms that do not 668 # have to access globale variables 669 # in shared libraries through functions 670 $def .= 671 "#INFO:" 672 .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":" 673 .join(',',@current_algorithms).";"; 674 $def .= "OPENSSL_EXTERN int $2_it;"; 675 $def .= 676 "#INFO:" 677 .join(',',@current_platforms).":" 678 .join(',',@current_algorithms).";"; 679 # Variant for platforms that have to 680 # access globale variables in shared 681 # libraries through functions 682 &$make_variant("$2_it","$2_it", 683 "EXPORT_VAR_AS_FUNCTION", 684 "FUNCTION"); 685 next; 686 } elsif (/^\s*DECLARE_ASN1_FUNCTIONS_fname\s*\(\s*(\w*)\s*,\s*(\w*)\s*,\s*(\w*)\s*\)/) { 687 $def .= "int d2i_$3(void);"; 688 $def .= "int i2d_$3(void);"; 689 $def .= "int $3_free(void);"; 690 $def .= "int $3_new(void);"; 691 # Variant for platforms that do not 692 # have to access globale variables 693 # in shared libraries through functions 694 $def .= 695 "#INFO:" 696 .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":" 697 .join(',',@current_algorithms).";"; 698 $def .= "OPENSSL_EXTERN int $2_it;"; 699 $def .= 700 "#INFO:" 701 .join(',',@current_platforms).":" 702 .join(',',@current_algorithms).";"; 703 # Variant for platforms that have to 704 # access globale variables in shared 705 # libraries through functions 706 &$make_variant("$2_it","$2_it", 707 "EXPORT_VAR_AS_FUNCTION", 708 "FUNCTION"); 709 next; 710 } elsif (/^\s*DECLARE_ASN1_FUNCTIONS\s*\(\s*(\w*)\s*\)/ || 711 /^\s*DECLARE_ASN1_FUNCTIONS_const\s*\(\s*(\w*)\s*\)/) { 712 $def .= "int d2i_$1(void);"; 713 $def .= "int i2d_$1(void);"; 714 $def .= "int $1_free(void);"; 715 $def .= "int $1_new(void);"; 716 # Variant for platforms that do not 717 # have to access globale variables 718 # in shared libraries through functions 719 $def .= 720 "#INFO:" 721 .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":" 722 .join(',',@current_algorithms).";"; 723 $def .= "OPENSSL_EXTERN int $1_it;"; 724 $def .= 725 "#INFO:" 726 .join(',',@current_platforms).":" 727 .join(',',@current_algorithms).";"; 728 # Variant for platforms that have to 729 # access globale variables in shared 730 # libraries through functions 731 &$make_variant("$1_it","$1_it", 732 "EXPORT_VAR_AS_FUNCTION", 733 "FUNCTION"); 734 next; 735 } elsif (/^\s*DECLARE_ASN1_ENCODE_FUNCTIONS_const\s*\(\s*(\w*)\s*,\s*(\w*)\s*\)/) { 736 $def .= "int d2i_$2(void);"; 737 $def .= "int i2d_$2(void);"; 738 # Variant for platforms that do not 739 # have to access globale variables 740 # in shared libraries through functions 741 $def .= 742 "#INFO:" 743 .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":" 744 .join(',',@current_algorithms).";"; 745 $def .= "OPENSSL_EXTERN int $2_it;"; 746 $def .= 747 "#INFO:" 748 .join(',',@current_platforms).":" 749 .join(',',@current_algorithms).";"; 750 # Variant for platforms that have to 751 # access globale variables in shared 752 # libraries through functions 753 &$make_variant("$2_it","$2_it", 754 "EXPORT_VAR_AS_FUNCTION", 755 "FUNCTION"); 756 next; 757 } elsif (/^\s*DECLARE_ASN1_ALLOC_FUNCTIONS\s*\(\s*(\w*)\s*\)/) { 758 $def .= "int $1_free(void);"; 759 $def .= "int $1_new(void);"; 760 next; 761 } elsif (/^\s*DECLARE_ASN1_FUNCTIONS_name\s*\(\s*(\w*)\s*,\s*(\w*)\s*\)/) { 762 $def .= "int d2i_$2(void);"; 763 $def .= "int i2d_$2(void);"; 764 $def .= "int $2_free(void);"; 765 $def .= "int $2_new(void);"; 766 # Variant for platforms that do not 767 # have to access globale variables 768 # in shared libraries through functions 769 $def .= 770 "#INFO:" 771 .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":" 772 .join(',',@current_algorithms).";"; 773 $def .= "OPENSSL_EXTERN int $2_it;"; 774 $def .= 775 "#INFO:" 776 .join(',',@current_platforms).":" 777 .join(',',@current_algorithms).";"; 778 # Variant for platforms that have to 779 # access globale variables in shared 780 # libraries through functions 781 &$make_variant("$2_it","$2_it", 782 "EXPORT_VAR_AS_FUNCTION", 783 "FUNCTION"); 784 next; 785 } elsif (/^\s*DECLARE_ASN1_ITEM\s*\(\s*(\w*)\s*\)/) { 786 # Variant for platforms that do not 787 # have to access globale variables 788 # in shared libraries through functions 789 $def .= 790 "#INFO:" 791 .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":" 792 .join(',',@current_algorithms).";"; 793 $def .= "OPENSSL_EXTERN int $1_it;"; 794 $def .= 795 "#INFO:" 796 .join(',',@current_platforms).":" 797 .join(',',@current_algorithms).";"; 798 # Variant for platforms that have to 799 # access globale variables in shared 800 # libraries through functions 801 &$make_variant("$1_it","$1_it", 802 "EXPORT_VAR_AS_FUNCTION", 803 "FUNCTION"); 804 next; 805 } elsif (/^\s*DECLARE_ASN1_NDEF_FUNCTION\s*\(\s*(\w*)\s*\)/) { 806 $def .= "int i2d_$1_NDEF(void);"; 807 } elsif (/^\s*DECLARE_ASN1_SET_OF\s*\(\s*(\w*)\s*\)/) { 808 next; 809 } elsif (/^\s*DECLARE_ASN1_PRINT_FUNCTION\s*\(\s*(\w*)\s*\)/) { 810 $def .= "int $1_print_ctx(void);"; 811 next; 812 } elsif (/^\s*DECLARE_ASN1_PRINT_FUNCTION_name\s*\(\s*(\w*)\s*,\s*(\w*)\s*\)/) { 813 $def .= "int $2_print_ctx(void);"; 814 next; 815 } elsif (/^\s*DECLARE_PKCS12_STACK_OF\s*\(\s*(\w*)\s*\)/) { 816 next; 817 } elsif (/^DECLARE_PEM_rw\s*\(\s*(\w*)\s*,/ || 818 /^DECLARE_PEM_rw_cb\s*\(\s*(\w*)\s*,/ || 819 /^DECLARE_PEM_rw_const\s*\(\s*(\w*)\s*,/ ) { 820 $def .= 821 "#INFO:" 822 .join(',',@current_platforms).":" 823 .join(',',"STDIO",@current_algorithms).";"; 824 $def .= "int PEM_read_$1(void);"; 825 $def .= "int PEM_write_$1(void);"; 826 $def .= 827 "#INFO:" 828 .join(',',@current_platforms).":" 829 .join(',',@current_algorithms).";"; 830 # Things that are everywhere 831 $def .= "int PEM_read_bio_$1(void);"; 832 $def .= "int PEM_write_bio_$1(void);"; 833 next; 834 } elsif (/^DECLARE_PEM_write\s*\(\s*(\w*)\s*,/ || 835 /^DECLARE_PEM_write_const\s*\(\s*(\w*)\s*,/ || 836 /^DECLARE_PEM_write_cb\s*\(\s*(\w*)\s*,/ ) { 837 $def .= 838 "#INFO:" 839 .join(',',@current_platforms).":" 840 .join(',',"STDIO",@current_algorithms).";"; 841 $def .= "int PEM_write_$1(void);"; 842 $def .= 843 "#INFO:" 844 .join(',',@current_platforms).":" 845 .join(',',@current_algorithms).";"; 846 # Things that are everywhere 847 $def .= "int PEM_write_bio_$1(void);"; 848 next; 849 } elsif (/^DECLARE_PEM_read\s*\(\s*(\w*)\s*,/ || 850 /^DECLARE_PEM_read_cb\s*\(\s*(\w*)\s*,/ ) { 851 $def .= 852 "#INFO:" 853 .join(',',@current_platforms).":" 854 .join(',',"STDIO",@current_algorithms).";"; 855 $def .= "int PEM_read_$1(void);"; 856 $def .= 857 "#INFO:" 858 .join(',',@current_platforms).":" 859 .join(',',"STDIO",@current_algorithms).";"; 860 # Things that are everywhere 861 $def .= "int PEM_read_bio_$1(void);"; 862 next; 863 } elsif (/^OPENSSL_DECLARE_GLOBAL\s*\(\s*(\w*)\s*,\s*(\w*)\s*\)/) { 864 # Variant for platforms that do not 865 # have to access globale variables 866 # in shared libraries through functions 867 $def .= 868 "#INFO:" 869 .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":" 870 .join(',',@current_algorithms).";"; 871 $def .= "OPENSSL_EXTERN int _shadow_$2;"; 872 $def .= 873 "#INFO:" 874 .join(',',@current_platforms).":" 875 .join(',',@current_algorithms).";"; 876 # Variant for platforms that have to 877 # access globale variables in shared 878 # libraries through functions 879 &$make_variant("_shadow_$2","_shadow_$2", 880 "EXPORT_VAR_AS_FUNCTION", 881 "FUNCTION"); 882 } elsif (/^\s*DEPRECATEDIN/) { 883 $parens = count_parens($_); 884 if ($parens == 0) { 885 $def .= do_deprecated($_, 886 \@current_platforms, 887 \@current_algorithms); 888 } else { 889 $stored_multiline = $_; 890 print STDERR "DEBUG: Found multiline DEPRECATEDIN starting with: $stored_multiline\n" if $debug; 891 next; 892 } 893 } elsif ($tag{'CONST_STRICT'} != 1) { 894 if (/\{|\/\*|\([^\)]*$/) { 895 $line = $_; 896 } else { 897 $def .= $_; 898 } 899 } 900 } 901 } 902 close(IN); 903 die "$file: Unmatched tags\n" if $#tag >= 0; 904 905 my $algs; 906 my $plays; 907 908 print STDERR "DEBUG: postprocessing ----------\n" if $debug; 909 foreach (split /;/, $def) { 910 my $s; my $k = "FUNCTION"; my $p; my $a; 911 s/^[\n\s]*//g; 912 s/[\n\s]*$//g; 913 next if(/\#undef/); 914 next if(/typedef\W/); 915 next if(/\#define/); 916 917 print STDERR "TRACE: processing $_\n" if $trace && !/^\#INFO:/; 918 # Reduce argument lists to empty () 919 # fold round brackets recursively: (t(*v)(t),t) -> (t{}{},t) -> {} 920 my $nsubst = 1; # prevent infinite loop, e.g., on int fn() 921 while($nsubst && /\(.*\)/s) { 922 $nsubst = s/\([^\(\)]+\)/\{\}/gs; 923 $nsubst+= s/\(\s*\*\s*(\w+)\s*\{\}\s*\)/$1/gs; #(*f{}) -> f 924 } 925 # pretend as we didn't use curly braces: {} -> () 926 s/\{\}/\(\)/gs; 927 928 s/STACK_OF\(\)/void/gs; 929 s/LHASH_OF\(\)/void/gs; 930 931 print STDERR "DEBUG: \$_ = \"$_\"\n" if $debug; 932 if (/^\#INFO:([^:]*):(.*)$/) { 933 $plats = $1; 934 $algs = $2; 935 print STDERR "DEBUG: found info on platforms ($plats) and algorithms ($algs)\n" if $debug; 936 next; 937 } elsif (/^\s*OPENSSL_EXTERN\s.*?(\w+(\{[0-9]+\})?)(\[[0-9]*\])*\s*$/) { 938 $s = $1; 939 $k = "VARIABLE"; 940 print STDERR "DEBUG: found external variable $s\n" if $debug; 941 } elsif (/TYPEDEF_\w+_OF/s) { 942 next; 943 } elsif (/(\w+)\s*\(\).*/s) { # first token prior [first] () is 944 $s = $1; # a function name! 945 print STDERR "DEBUG: found function $s\n" if $debug; 946 } elsif (/\(/ and not (/=/)) { 947 print STDERR "File $file: cannot parse: $_;\n"; 948 next; 949 } else { 950 next; 951 } 952 953 $syms{$s} = 1; 954 $kind{$s} = $k; 955 956 $p = $plats; 957 $a = $algs; 958 959 $platform{$s} = 960 &reduce_platforms((defined($platform{$s})?$platform{$s}.',':"").$p); 961 $algorithm{$s} .= ','.$a; 962 963 if (defined($variant{$s})) { 964 foreach $v (split /;/,$variant{$s}) { 965 (my $r, my $p, my $k) = split(/:/,$v); 966 my $ip = join ',',map({ /^!(.*)$/ ? $1 : "!".$_ } split /,/, $p); 967 $syms{$r} = 1; 968 if (!defined($k)) { $k = $kind{$s}; } 969 $kind{$r} = $k."(".$s.")"; 970 $algorithm{$r} = $algorithm{$s}; 971 $platform{$r} = &reduce_platforms($platform{$s}.",".$p.",".$p); 972 $platform{$s} = &reduce_platforms($platform{$s}.','.$ip.','.$ip); 973 print STDERR "DEBUG: \$variant{\"$s\"} = ",$v,"; \$r = $r; \$p = ",$platform{$r},"; \$a = ",$algorithm{$r},"; \$kind = ",$kind{$r},"\n" if $debug; 974 } 975 } 976 print STDERR "DEBUG: \$s = $s; \$p = ",$platform{$s},"; \$a = ",$algorithm{$s},"; \$kind = ",$kind{$s},"\n" if $debug; 977 } 978 } 979 980 # Prune the returned symbols 981 982 delete $syms{"bn_dump1"}; 983 $platform{"BIO_s_log"} .= ",!WIN32,!macintosh"; 984 985 $platform{"PEM_read_NS_CERT_SEQ"} = "VMS"; 986 $platform{"PEM_write_NS_CERT_SEQ"} = "VMS"; 987 $platform{"PEM_read_P8_PRIV_KEY_INFO"} = "VMS"; 988 $platform{"PEM_write_P8_PRIV_KEY_INFO"} = "VMS"; 989 990 # Info we know about 991 992 push @ret, map { $_."\\".&info_string($_,"EXIST", 993 $platform{$_}, 994 $kind{$_}, 995 $algorithm{$_}) } keys %syms; 996 997 if (keys %unknown_algorithms) { 998 print STDERR "WARNING: mkdef.pl doesn't know the following algorithms:\n"; 999 print STDERR "\t",join("\n\t",keys %unknown_algorithms),"\n"; 1000 } 1001 return(@ret); 1002} 1003 1004# Param: string of comma-separated platform-specs. 1005sub reduce_platforms 1006{ 1007 my ($platforms) = @_; 1008 my $pl = defined($platforms) ? $platforms : ""; 1009 my %p = map { $_ => 0 } split /,/, $pl; 1010 my $ret; 1011 1012 print STDERR "DEBUG: Entered reduce_platforms with \"$platforms\"\n" 1013 if $debug; 1014 # We do this, because if there's code like the following, it really 1015 # means the function exists in all cases and should therefore be 1016 # everywhere. By increasing and decreasing, we may attain 0: 1017 # 1018 # ifndef WIN16 1019 # int foo(); 1020 # else 1021 # int _fat foo(); 1022 # endif 1023 foreach $platform (split /,/, $pl) { 1024 if ($platform =~ /^!(.*)$/) { 1025 $p{$1}--; 1026 } else { 1027 $p{$platform}++; 1028 } 1029 } 1030 foreach $platform (keys %p) { 1031 if ($p{$platform} == 0) { delete $p{$platform}; } 1032 } 1033 1034 delete $p{""}; 1035 1036 $ret = join(',',sort(map { $p{$_} < 0 ? "!".$_ : $_ } keys %p)); 1037 print STDERR "DEBUG: Exiting reduce_platforms with \"$ret\"\n" 1038 if $debug; 1039 return $ret; 1040} 1041 1042sub info_string 1043{ 1044 (my $symbol, my $exist, my $platforms, my $kind, my $algorithms) = @_; 1045 1046 my %a = defined($algorithms) ? 1047 map { $_ => 1 } split /,/, $algorithms : (); 1048 my $k = defined($kind) ? $kind : "FUNCTION"; 1049 my $ret; 1050 my $p = &reduce_platforms($platforms); 1051 1052 delete $a{""}; 1053 1054 $ret = $exist; 1055 $ret .= ":".$p; 1056 $ret .= ":".$k; 1057 $ret .= ":".join(',',sort keys %a); 1058 return $ret; 1059} 1060 1061sub maybe_add_info 1062{ 1063 (my $name, *nums, my @symbols) = @_; 1064 my $sym; 1065 my $new_info = 0; 1066 my %syms=(); 1067 1068 foreach $sym (@symbols) { 1069 (my $s, my $i) = split /\\/, $sym; 1070 if (defined($nums{$s})) { 1071 $i =~ s/^(.*?:.*?:\w+)(\(\w+\))?/$1/; 1072 (my $n, my $vers, my $dummy) = split /\\/, $nums{$s}; 1073 if (!defined($dummy) || $i ne $dummy) { 1074 $nums{$s} = $n."\\".$vers."\\".$i; 1075 $new_info++; 1076 print STDERR "DEBUG: maybe_add_info for $s: \"$dummy\" => \"$i\"\n" if $debug; 1077 } 1078 } 1079 $syms{$s} = 1; 1080 } 1081 1082 my @s=sort { &parse_number($nums{$a},"n") <=> &parse_number($nums{$b},"n") } keys %nums; 1083 foreach $sym (@s) { 1084 (my $n, my $vers, my $i) = split /\\/, $nums{$sym}; 1085 if (!defined($syms{$sym}) && $i !~ /^NOEXIST:/) { 1086 $new_info++; 1087 print STDERR "DEBUG: maybe_add_info for $sym: -> undefined\n" if $debug; 1088 } 1089 } 1090 if ($new_info) { 1091 print STDERR "$name: $new_info old symbols have updated info\n"; 1092 if (!$do_rewrite) { 1093 print STDERR "You should do a rewrite to fix this.\n"; 1094 } 1095 } else { 1096 } 1097} 1098 1099# Param: string of comma-separated keywords, each possibly prefixed with a "!" 1100sub is_valid 1101{ 1102 my ($keywords_txt,$platforms) = @_; 1103 my (@keywords) = split /,/,$keywords_txt; 1104 my ($falsesum, $truesum) = (0, 1); 1105 1106 # Param: one keyword 1107 sub recognise 1108 { 1109 my ($keyword,$platforms) = @_; 1110 1111 if ($platforms) { 1112 # platforms 1113 if ($keyword eq "UNIX" && $UNIX) { return 1; } 1114 if ($keyword eq "VMS" && $VMS) { return 1; } 1115 if ($keyword eq "WIN32" && $W32) { return 1; } 1116 if ($keyword eq "_WIN32" && $W32) { return 1; } 1117 if ($keyword eq "WINNT" && $NT) { return 1; } 1118 # Special platforms: 1119 # EXPORT_VAR_AS_FUNCTION means that global variables 1120 # will be represented as functions. 1121 if ($keyword eq "EXPORT_VAR_AS_FUNCTION" && $W32) { 1122 return 1; 1123 } 1124 if ($keyword eq "ZLIB" && $zlib) { return 1; } 1125 return 0; 1126 } else { 1127 # algorithms 1128 if ($disabled_algorithms{$keyword} == 1) { return 0;} 1129 1130 # Nothing recognise as true 1131 return 1; 1132 } 1133 } 1134 1135 foreach $k (@keywords) { 1136 if ($k =~ /^!(.*)$/) { 1137 $falsesum += &recognise($1,$platforms); 1138 } else { 1139 $truesum *= &recognise($k,$platforms); 1140 } 1141 } 1142 print STDERR "DEBUG: [",$#keywords,",",$#keywords < 0,"] is_valid($keywords_txt) => (\!$falsesum) && $truesum = ",(!$falsesum) && $truesum,"\n" if $debug; 1143 return (!$falsesum) && $truesum; 1144} 1145 1146sub print_test_file 1147{ 1148 (*OUT,my $name,*nums,my $testall,my @symbols)=@_; 1149 my $n = 1; my @e; my @r; 1150 my $sym; my $prev = ""; my $prefSSLeay; 1151 1152 (@e)=grep(/^SSLeay(\{[0-9]+\})?\\.*?:.*?:.*/,@symbols); 1153 (@r)=grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:.*/ && !/^SSLeay(\{[0-9]+\})?\\.*?:.*?:.*/,@symbols); 1154 @symbols=((sort @e),(sort @r)); 1155 1156 foreach $sym (@symbols) { 1157 (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/; 1158 my $v = 0; 1159 $v = 1 if $i=~ /^.*?:.*?:VARIABLE/; 1160 my $p = ($i =~ /^[^:]*:([^:]*):/,$1); 1161 my $a = ($i =~ /^[^:]*:[^:]*:[^:]*:([^:]*)/,$1); 1162 if (!defined($nums{$s})) { 1163 print STDERR "Warning: $s does not have a number assigned\n" 1164 if(!$do_update); 1165 } elsif (is_valid($p,1) && is_valid($a,0)) { 1166 my $s2 = ($s =~ /^(.*?)(\{[0-9]+\})?$/, $1); 1167 if ($prev eq $s2) { 1168 print OUT "\t/* The following has already appeared previously */\n"; 1169 print STDERR "Warning: Symbol '",$s2,"' redefined. old=",($nums{$prev} =~ /^(.*?)\\/,$1),", new=",($nums{$s2} =~ /^(.*?)\\/,$1),"\n"; 1170 } 1171 $prev = $s2; # To warn about duplicates... 1172 1173 (my $nn, my $vers, my $ni) = split /\\/, $nums{$s2}; 1174 if ($v) { 1175 print OUT "\textern int $s2; /* type unknown */ /* $nn $ni */\n"; 1176 } else { 1177 print OUT "\textern int $s2(); /* type unknown */ /* $nn $ni */\n"; 1178 } 1179 } 1180 } 1181} 1182 1183sub get_version 1184{ 1185 return $config{version}; 1186} 1187 1188sub print_def_file 1189{ 1190 (*OUT,my $name,*nums,my @symbols)=@_; 1191 my $n = 1; my @e; my @r; my @v; my $prev=""; 1192 my $liboptions=""; 1193 my $libname = $name; 1194 my $http_vendor = 'www.openssl.org/'; 1195 my $version = get_version(); 1196 my $what = "OpenSSL: implementation of Secure Socket Layer"; 1197 my $description = "$what $version, $name - http://$http_vendor"; 1198 my $prevsymversion = "", $prevprevsymversion = ""; 1199 # For VMS 1200 my $prevnum = 0; 1201 my $symvtextcount = 0; 1202 1203 if ($W32) 1204 { $libname.="32"; } 1205 1206 if ($W32) 1207 { 1208 print OUT <<"EOF"; 1209; 1210; Definition file for the DLL version of the $name library from OpenSSL 1211; 1212 1213LIBRARY $libname $liboptions 1214 1215EOF 1216 1217 print "EXPORTS\n"; 1218 } 1219 elsif ($VMS) 1220 { 1221 print OUT <<"EOF"; 1222CASE_SENSITIVE=YES 1223SYMBOL_VECTOR=(- 1224EOF 1225 $symvtextcount = 16; # length of "SYMBOL_VECTOR=(-" 1226 } 1227 1228 (@r)=grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:FUNCTION/,@symbols); 1229 (@v)=grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:VARIABLE/,@symbols); 1230 if ($VMS) { 1231 # VMS needs to have the symbols on slot number order 1232 @symbols=(map { $_->[1] } 1233 sort { $a->[0] <=> $b->[0] } 1234 map { (my $s, my $i) = $_ =~ /^(.*?)\\(.*)$/; 1235 die "Error: $s doesn't have a number assigned\n" 1236 if !defined($nums{$s}); 1237 (my $n, my @rest) = split /\\/, $nums{$s}; 1238 [ $n, $_ ] } (@e, @r, @v)); 1239 } else { 1240 @symbols=((sort @e),(sort @r), (sort @v)); 1241 } 1242 1243 my ($baseversion, $currversion) = get_openssl_version(); 1244 my $thisversion; 1245 do { 1246 if (!defined($thisversion)) { 1247 $thisversion = $baseversion; 1248 } else { 1249 $thisversion = get_next_version($thisversion); 1250 } 1251 foreach $sym (@symbols) { 1252 (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/; 1253 my $v = 0; 1254 $v = 1 if $i =~ /^.*?:.*?:VARIABLE/; 1255 if (!defined($nums{$s})) { 1256 die "Error: $s does not have a number assigned\n" 1257 if(!$do_update); 1258 } else { 1259 (my $n, my $symversion, my $dummy) = split /\\/, $nums{$s}; 1260 my %pf = (); 1261 my $p = ($i =~ /^[^:]*:([^:]*):/,$1); 1262 my $a = ($i =~ /^[^:]*:[^:]*:[^:]*:([^:]*)/,$1); 1263 if (is_valid($p,1) && is_valid($a,0)) { 1264 my $s2 = ($s =~ /^(.*?)(\{[0-9]+\})?$/, $1); 1265 if ($prev eq $s2) { 1266 print STDERR "Warning: Symbol '",$s2, 1267 "' redefined. old=",($nums{$prev} =~ /^(.*?)\\/,$1), 1268 ", new=",($nums{$s2} =~ /^(.*?)\\/,$1),"\n"; 1269 } 1270 $prev = $s2; # To warn about duplicates... 1271 if($linux) { 1272 next if $symversion ne $thisversion; 1273 if ($symversion ne $prevsymversion) { 1274 if ($prevsymversion ne "") { 1275 if ($prevprevsymversion ne "") { 1276 print OUT "} OPENSSL${SO_VARIANT}_" 1277 ."$prevprevsymversion;\n\n"; 1278 } else { 1279 print OUT "};\n\n"; 1280 } 1281 } 1282 print OUT "OPENSSL${SO_VARIANT}_$symversion {\n global:\n"; 1283 $prevprevsymversion = $prevsymversion; 1284 $prevsymversion = $symversion; 1285 } 1286 print OUT " $s2;\n"; 1287 } elsif ($VMS) { 1288 while(++$prevnum < $n) { 1289 my $symline=" ,SPARE -\n ,SPARE -\n"; 1290 if ($symvtextcount + length($symline) - 2 > 1024) { 1291 print OUT ")\nSYMBOL_VECTOR=(-\n"; 1292 $symvtextcount = 16; # length of "SYMBOL_VECTOR=(-" 1293 } 1294 if ($symvtextcount == 16) { 1295 # Take away first comma 1296 $symline =~ s/,//; 1297 } 1298 print OUT $symline; 1299 $symvtextcount += length($symline) - 2; 1300 } 1301 (my $s_uc = $s) =~ tr/a-z/A-Z/; 1302 my $symtype= 1303 $v ? "DATA" : "PROCEDURE"; 1304 my $symline= 1305 ($s_uc ne $s 1306 ? " ,$s_uc/$s=$symtype -\n ,$s=$symtype -\n" 1307 : " ,$s=$symtype -\n ,SPARE -\n"); 1308 if ($symvtextcount + length($symline) - 2 > 1024) { 1309 print OUT ")\nSYMBOL_VECTOR=(-\n"; 1310 $symvtextcount = 16; # length of "SYMBOL_VECTOR=(-" 1311 } 1312 if ($symvtextcount == 16) { 1313 # Take away first comma 1314 $symline =~ s/,//; 1315 } 1316 print OUT $symline; 1317 $symvtextcount += length($symline) - 2; 1318 } elsif($v) { 1319 printf OUT " %s%-39s DATA\n", 1320 ($W32)?"":"_",$s2; 1321 } else { 1322 printf OUT " %s%s\n", 1323 ($W32)?"":"_",$s2; 1324 } 1325 } 1326 } 1327 } 1328 } while ($linux && $thisversion ne $currversion); 1329 if ($linux) { 1330 if ($prevprevsymversion ne "") { 1331 print OUT " local: *;\n} OPENSSL${SO_VARIANT}_$prevprevsymversion;\n\n"; 1332 } else { 1333 print OUT " local: *;\n};\n\n"; 1334 } 1335 } elsif ($VMS) { 1336 print OUT ")\n"; 1337 (my $libvmaj, my $libvmin, my $libvedit) = 1338 $currversion =~ /^(\d+)_(\d+)_(\d+)$/; 1339 # The reason to multiply the edit number with 100 is to make space 1340 # for the possibility that we want to encode the patch letters 1341 print OUT "GSMATCH=LEQUAL,",($libvmaj * 100 + $libvmin),",",($libvedit * 100),"\n"; 1342 } 1343 printf OUT "\n"; 1344} 1345 1346sub load_numbers 1347{ 1348 my($name)=@_; 1349 my(@a,%ret); 1350 my $prevversion; 1351 1352 $max_num = 0; 1353 $num_noinfo = 0; 1354 $prev = ""; 1355 $prev_cnt = 0; 1356 1357 my ($baseversion, $currversion) = get_openssl_version(); 1358 1359 open(IN,"<$name") || die "unable to open $name:$!\n"; 1360 while (<IN>) { 1361 s|\R$||; # Better chomp 1362 s/#.*$//; 1363 next if /^\s*$/; 1364 @a=split; 1365 if (defined $ret{$a[0]}) { 1366 # This is actually perfectly OK 1367 #print STDERR "Warning: Symbol '",$a[0],"' redefined. old=",$ret{$a[0]},", new=",$a[1],"\n"; 1368 } 1369 if ($max_num > $a[1]) { 1370 print STDERR "Warning: Number decreased from ",$max_num," to ",$a[1],"\n"; 1371 } 1372 elsif ($max_num == $a[1]) { 1373 # This is actually perfectly OK 1374 #print STDERR "Warning: Symbol ",$a[0]," has same number as previous ",$prev,": ",$a[1],"\n"; 1375 if ($a[0] eq $prev) { 1376 $prev_cnt++; 1377 $a[0] .= "{$prev_cnt}"; 1378 } 1379 } 1380 else { 1381 $prev_cnt = 0; 1382 } 1383 if ($#a < 2) { 1384 # Existence will be proven later, in do_defs 1385 $ret{$a[0]}=$a[1]; 1386 $num_noinfo++; 1387 } else { 1388 #Sanity check the version number 1389 if (defined $prevversion) { 1390 check_version_lte($prevversion, $a[2]); 1391 } 1392 check_version_lte($a[2], $currversion); 1393 $prevversion = $a[2]; 1394 $ret{$a[0]}=$a[1]."\\".$a[2]."\\".$a[3]; # \\ is a special marker 1395 } 1396 $max_num = $a[1] if $a[1] > $max_num; 1397 $prev=$a[0]; 1398 } 1399 if ($num_noinfo) { 1400 print STDERR "Warning: $num_noinfo symbols were without info." if $verbose || !$do_rewrite; 1401 if ($do_rewrite) { 1402 printf STDERR " The rewrite will fix this.\n" if $verbose; 1403 } else { 1404 printf STDERR " You should do a rewrite to fix this.\n"; 1405 } 1406 } 1407 close(IN); 1408 return(%ret); 1409} 1410 1411sub parse_number 1412{ 1413 (my $str, my $what) = @_; 1414 (my $n, my $v, my $i) = split(/\\/,$str); 1415 if ($what eq "n") { 1416 return $n; 1417 } else { 1418 return $i; 1419 } 1420} 1421 1422sub rewrite_numbers 1423{ 1424 (*OUT,$name,*nums,@symbols)=@_; 1425 my $thing; 1426 1427 my @r = grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:\w+\(\w+\)/,@symbols); 1428 my $r; my %r; my %rsyms; 1429 foreach $r (@r) { 1430 (my $s, my $i) = split /\\/, $r; 1431 my $a = $1 if $i =~ /^.*?:.*?:\w+\((\w+)\)/; 1432 $i =~ s/^(.*?:.*?:\w+)\(\w+\)/$1/; 1433 $r{$a} = $s."\\".$i; 1434 $rsyms{$s} = 1; 1435 } 1436 1437 my %syms = (); 1438 foreach $_ (@symbols) { 1439 (my $n, my $i) = split /\\/; 1440 $syms{$n} = 1; 1441 } 1442 1443 my @s=sort { 1444 &parse_number($nums{$a},"n") <=> &parse_number($nums{$b},"n") 1445 || $a cmp $b 1446 } keys %nums; 1447 foreach $sym (@s) { 1448 (my $n, my $vers, my $i) = split /\\/, $nums{$sym}; 1449 next if defined($i) && $i =~ /^.*?:.*?:\w+\(\w+\)/; 1450 next if defined($rsyms{$sym}); 1451 print STDERR "DEBUG: rewrite_numbers for sym = ",$sym,": i = ",$i,", n = ",$n,", rsym{sym} = ",$rsyms{$sym},"syms{sym} = ",$syms{$sym},"\n" if $debug; 1452 $i="NOEXIST::FUNCTION:" 1453 if !defined($i) || $i eq "" || !defined($syms{$sym}); 1454 my $s2 = $sym; 1455 $s2 =~ s/\{[0-9]+\}$//; 1456 printf OUT "%s%-39s %d\t%s\t%s\n","",$s2,$n,$vers,$i; 1457 if (exists $r{$sym}) { 1458 (my $s, $i) = split /\\/,$r{$sym}; 1459 my $s2 = $s; 1460 $s2 =~ s/\{[0-9]+\}$//; 1461 printf OUT "%s%-39s %d\t%s\t%s\n","",$s2,$n,$vers,$i; 1462 } 1463 } 1464} 1465 1466sub update_numbers 1467{ 1468 (*OUT,$name,*nums,my $start_num, my @symbols)=@_; 1469 my $new_syms = 0; 1470 my $basevers; 1471 my $vers; 1472 1473 ($basevers, $vers) = get_openssl_version(); 1474 1475 my @r = grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:\w+\(\w+\)/,@symbols); 1476 my $r; my %r; my %rsyms; 1477 foreach $r (@r) { 1478 (my $s, my $i) = split /\\/, $r; 1479 my $a = $1 if $i =~ /^.*?:.*?:\w+\((\w+)\)/; 1480 $i =~ s/^(.*?:.*?:\w+)\(\w+\)/$1/; 1481 $r{$a} = $s."\\".$i; 1482 $rsyms{$s} = 1; 1483 } 1484 1485 foreach $sym (@symbols) { 1486 (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/; 1487 next if $i =~ /^.*?:.*?:\w+\(\w+\)/; 1488 next if defined($rsyms{$sym}); 1489 die "ERROR: Symbol $sym had no info attached to it." 1490 if $i eq ""; 1491 if (!exists $nums{$s}) { 1492 $new_syms++; 1493 my $s2 = $s; 1494 $s2 =~ s/\{[0-9]+\}$//; 1495 printf OUT "%s%-39s %d\t%s\t%s\n","",$s2, ++$start_num,$vers,$i; 1496 if (exists $r{$s}) { 1497 ($s, $i) = split /\\/,$r{$s}; 1498 $s =~ s/\{[0-9]+\}$//; 1499 printf OUT "%s%-39s %d\t%s\t%s\n","",$s, $start_num,$vers,$i; 1500 } 1501 } 1502 } 1503 if($new_syms) { 1504 print STDERR "$name: Added $new_syms new symbols\n"; 1505 } else { 1506 print STDERR "$name: No new symbols added\n"; 1507 } 1508} 1509 1510sub check_existing 1511{ 1512 (*nums, my @symbols)=@_; 1513 my %existing; my @remaining; 1514 @remaining=(); 1515 foreach $sym (@symbols) { 1516 (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/; 1517 $existing{$s}=1; 1518 } 1519 foreach $sym (keys %nums) { 1520 if (!exists $existing{$sym}) { 1521 push @remaining, $sym; 1522 } 1523 } 1524 if(@remaining) { 1525 print STDERR "The following symbols do not seem to exist:\n"; 1526 foreach $sym (@remaining) { 1527 print STDERR "\t",$sym,"\n"; 1528 } 1529 } 1530} 1531 1532sub count_parens 1533{ 1534 my $line = shift(@_); 1535 1536 my $open = $line =~ tr/\(//; 1537 my $close = $line =~ tr/\)//; 1538 1539 return $open - $close; 1540} 1541 1542#Parse opensslv.h to get the current version number. Also work out the base 1543#version, i.e. the lowest version number that is binary compatible with this 1544#version 1545sub get_openssl_version() 1546{ 1547 my $fn = catfile($config{sourcedir},"include","openssl","opensslv.h"); 1548 open (IN, "$fn") || die "Can't open opensslv.h"; 1549 1550 while(<IN>) { 1551 if (/OPENSSL_VERSION_TEXT\s+"OpenSSL (\d\.\d\.)(\d[a-z]*)(-| )/) { 1552 my $suffix = $2; 1553 (my $baseversion = $1) =~ s/\./_/g; 1554 close IN; 1555 return ($baseversion."0", $baseversion.$suffix); 1556 } 1557 } 1558 die "Can't find OpenSSL version number\n"; 1559} 1560 1561#Given an OpenSSL version number, calculate the next version number. If the 1562#version number gets to a.b.czz then we go to a.b.(c+1) 1563sub get_next_version() 1564{ 1565 my $thisversion = shift; 1566 1567 my ($base, $letter) = $thisversion =~ /^(\d_\d_\d)([a-z]{0,2})$/; 1568 1569 if ($letter eq "zz") { 1570 my $lastnum = substr($base, -1); 1571 return substr($base, 0, length($base)-1).(++$lastnum); 1572 } 1573 return $base.get_next_letter($letter); 1574} 1575 1576#Given the letters off the end of an OpenSSL version string, calculate what 1577#the letters for the next release would be. 1578sub get_next_letter() 1579{ 1580 my $thisletter = shift; 1581 my $baseletter = ""; 1582 my $endletter; 1583 1584 if ($thisletter eq "") { 1585 return "a"; 1586 } 1587 if ((length $thisletter) > 1) { 1588 ($baseletter, $endletter) = $thisletter =~ /([a-z]+)([a-z])/; 1589 } else { 1590 $endletter = $thisletter; 1591 } 1592 1593 if ($endletter eq "z") { 1594 return $thisletter."a"; 1595 } else { 1596 return $baseletter.(++$endletter); 1597 } 1598} 1599 1600#Check if a version is less than or equal to the current version. Its a fatal 1601#error if not. They must also only differ in letters, or the last number (i.e. 1602#the first two numbers must be the same) 1603sub check_version_lte() 1604{ 1605 my ($testversion, $currversion) = @_; 1606 my $lentv; 1607 my $lencv; 1608 my $cvbase; 1609 1610 my ($cvnums) = $currversion =~ /^(\d_\d_\d)[a-z]*$/; 1611 my ($tvnums) = $testversion =~ /^(\d_\d_\d)[a-z]*$/; 1612 1613 #Die if we can't parse the version numbers or they don't look sane 1614 die "Invalid version number: $testversion and $currversion\n" 1615 if (!defined($cvnums) || !defined($tvnums) 1616 || length($cvnums) != 5 1617 || length($tvnums) != 5); 1618 1619 #If the base versions (without letters) don't match check they only differ 1620 #in the last number 1621 if ($cvnums ne $tvnums) { 1622 die "Invalid version number: $testversion " 1623 ."for current version $currversion\n" 1624 if (substr($cvnums, -1) < substr($tvnums, -1) 1625 || substr($cvnums, 0, 4) ne substr($tvnums, 0, 4)); 1626 return; 1627 } 1628 #If we get here then the base version (i.e. the numbers) are the same - they 1629 #only differ in the letters 1630 1631 $lentv = length $testversion; 1632 $lencv = length $currversion; 1633 1634 #If the testversion has more letters than the current version then it must 1635 #be later (or malformed) 1636 if ($lentv > $lencv) { 1637 die "Invalid version number: $testversion " 1638 ."is greater than $currversion\n"; 1639 } 1640 1641 #Get the last letter from the current version 1642 my ($cvletter) = $currversion =~ /([a-z])$/; 1643 if (defined $cvletter) { 1644 ($cvbase) = $currversion =~ /(\d_\d_\d[a-z]*)$cvletter$/; 1645 } else { 1646 $cvbase = $currversion; 1647 } 1648 die "Unable to parse version number $currversion" if (!defined $cvbase); 1649 my $tvbase; 1650 my ($tvletter) = $testversion =~ /([a-z])$/; 1651 if (defined $tvletter) { 1652 ($tvbase) = $testversion =~ /(\d_\d_\d[a-z]*)$tvletter$/; 1653 } else { 1654 $tvbase = $testversion; 1655 } 1656 die "Unable to parse version number $testversion" if (!defined $tvbase); 1657 1658 if ($lencv > $lentv) { 1659 #If current version has more letters than testversion then testversion 1660 #minus the final letter must be a substring of the current version 1661 die "Invalid version number $testversion " 1662 ."is greater than $currversion or is invalid\n" 1663 if (index($cvbase, $tvbase) != 0); 1664 } else { 1665 #If both versions have the same number of letters then they must be 1666 #equal up to the last letter, and the last letter in testversion must 1667 #be less than or equal to the last letter in current version. 1668 die "Invalid version number $testversion " 1669 ."is greater than $currversion\n" 1670 if (($cvbase ne $tvbase) && ($tvletter gt $cvletter)); 1671 } 1672} 1673 1674sub do_deprecated() 1675{ 1676 my ($decl, $plats, $algs) = @_; 1677 $decl =~ /^\s*(DEPRECATEDIN_\d+_\d+_\d+)\s*\((.*)\)\s*$/ 1678 or die "Bad DEPRECTEDIN: $decl\n"; 1679 my $info1 .= "#INFO:"; 1680 $info1 .= join(',', @{$plats}) . ":"; 1681 my $info2 = $info1; 1682 $info1 .= join(',',@{$algs}, $1) . ";"; 1683 $info2 .= join(',',@{$algs}) . ";"; 1684 return $info1 . $2 . ";" . $info2; 1685} 1686